Question

将数据从一个工作簿迁移到另一个工作簿。在新的工作簿中，我只想要特定的列（几乎是250）。由于Master文件中的数据不一致且不在同一范围内，因此如何提取这250列？因为，我是VBA的新手，我已经尝试了下面的代码，它正在工作，但我必须为所有250列编写长代码？任何帮助将不胜感激。

Sub Data_Migration()

Dim y As Workbook
Dim x As Workbook
Dim ws As Worksheet
Dim sh As Worksheet
Dim rng As Range
Set y = ThisWorkbook
Application.ScreenUpdating = 0



Set x = Workbooks.Open("file path")
 'Column Q from master file with worksheet name cba is copied in new workbook with sheet name abc and pasted in column D
Set ws = y.Sheets("abc")
Set sh = x.Sheets("cba")
Set rng = sh.Range("Q2:Q11443") 
rng.Copy
y.Sheets("abc").Range("D1").PasteSpecial xlValues
Application.CutCopyMode = False


Set ws = y.Sheets("abc")
Set sh = x.Sheets("cba")
Set rng = sh.Range("Z2:Z11443") 
rng.Copy
y.Sheets("abc").Range("E1").PasteSpecial xlValues
Application.CutCopyMode = False


Set ws = y.Sheets("abc")
Set sh = x.Sheets("cba")
Set rng = sh.Range("AI2:AI11443") 
rng.Copy
y.Sheets("abc").Range("F1").PasteSpecial xlValues
Application.CutCopyMode = False

x.Close
End sub

Answer 1

你需要一个For .. Next循环。基本上，

Dim C As Long
For C = 1 to 250
    ' enter repetitive code here
Next C

如果C是您的列号，您可以使用C作为列号而不是“A”，“B”，“C”。 Excel不是很擅长写信。它将您键入的A转换为1，B转换为2，C转换为3等 - 最多250。

但是，您似乎不需要连续的列。因此，您需要创建所需数字的数组。

Dim Arr As Variant
Arr = Array(1, 12, 16, 25, 32)  ' list all your 250 columns.

现在，Arr（0）= 1，Arr（1）= 12，Arr（2）= 16等。并构建循环以引用这些数字。

Dim n As Integer
For n = 0 to Ubound(Arr)    ' that the number of elements in Arr
    C = Arr(n)
    Debug.Print C      ' this will write C in the immediate window
Next n

在此结构中，您可以使用C作为列号，例如

Set Rng = Sh.Range(Cells(3, C), Cells(11443, C))

单元格（3，C）指定A3，如果C = 1

PS刚刚想到你也可能需要这个： - 范围（“ZH2”）。列应返回“ZH”列的列号

Answer 2

将以下代码粘贴到标准代码模块中（默认情况下为“Module1”，但您可以根据自己的喜好对其进行命名）。

Sub Main()
    ' 21 Mar 2017

    Dim WsS As Worksheet                        ' S = Source
    Dim WbT As Workbook, WsT As Worksheet       ' T = Target
    Dim Cs As Long, Ct As Long                  ' Column numbers: Source & Target
    Dim Clms As Variant
    Dim i As Integer                            ' index for Clms

    Application.ScreenUpdating = False
    On Error GoTo ErrExit
    ' Source is the first worksheet in the active workbook:
    Set WsS = ActiveWorkbook.Worksheets("Haseev")
    Set WbT = Workbooks.Add(xlWBATWorksheet)
    Set WsT = WbT.Worksheets(1)
    WsT.Name = "Extract 250"                    'name the target sheet

    Clms = Array(1, 4, 8, 13)                   ' list column numbers < 17
    For i = 0 To UBound(Clms)
        CopyColumn WsS, WsT, Clms(i), Ct
    Next i

    For Cs = 17 To Columns("CHU").Column Step 9
        CopyColumn WsS, WsT, Cs, Ct
''''        If Ct > 10 Then Exit For
    Next Cs
ErrExit:
    Application.ScreenUpdating = True
End Sub

理解代码： - 使当前活动的工作簿成为“源”，这意味着您必须查看要从中复制数据的工作簿。代码期望在此工作簿中找到名为“Haseev”的工作表。更改代码中的名称或将整行代码更改为

Set WsS = ActiveWorkbook.Worksheets(1)

这指定了工作簿中的第一个工作表，因为像你这样的大型工作簿不太可能有太多的工作表。

代码将创建一个新工作簿，其中包含一个工作表。它将该表命名为“Extract 250”。将代码中的名称更改为您喜欢的名称。接下来，代码将选定的列复制到新工作簿。

Clms = Array(1, 4, 8, 13)

您可以指定要复制的列 - 您需要的数量，以逗号分隔的数字。如果你不想要任何，只需将规范留空，例如RTI = Array（）

在下一个循环中，复制每个第9列，从第17列开始到“CHU”列。您可以修改“CHU”。这条线

''''        If Ct > 10 Then Exit For

是我测试的遗留物。您可能希望将其用于同一目的。删除禁用代码的撇号，并且在将10列复制到新工作簿后，循环将停止复制。

您可能会注意到上述代码不包含任何副本或粘贴。相反，它会调用您应该粘贴在上面已复制的主过程下面的下一个子。

Private Sub CopyColumn(WsS As Worksheet, _
                       WsT As Worksheet, _
                       ByVal Cs As Long, _
                       Ct As Long)
    ' 21 Mar 2017
    ' Ct is a return Long

    If Cs > 0 Then              ' column number must be > 0
        Ct = Ct + 1
        WsS.Columns(Cs).Copy Destination:=WsT.Columns(Ct)
    End If

End Sub

基本上，Main程序只管理这个sub将被调用的250多次。

输出工作簿将具有Excel给出的通用名称，如“Sheet1”。您可以将其保存在您希望的任何名称下，也可以将其关闭，并在下次查看时再创建一个新名称。

将特定列（几乎250个）从一个Excel工作簿迁移到另一个Excel工作簿

2 个答案: