Excel VBA：将特定工作簿中的单元格循环复制到另一个

Question

我是VBA的新手，正在编写一个宏。 目的是遍历电子表格的列表（我在同一目录中保存了两套电子表格，每套都有特定的命名约定）。 一组称为“ GenLU_xx”，另一组称为“ LUZ_Summary_xx”。 每个名称中的“ xx”表示一个名称，例如卡尔加里。 因此，我将为卡尔加里创建两个不同的电子表格（LUZ_Summary_Calgary和GenLU_Calgary）。

宏需要打开每个以“ LUZ”开头的电子表格，并向G1添加一个值。 我已经通过修改在此找到的代码来完成了第一部分： http : //www.thespreadsheetguru.com/the-code-vault/2014/4/23/loop-through-all-excel-files-in-a-given -folder宏要求用户标识电子表格的存储目录，然后循环浏览以“ LUZ *”开头的电子表格。 代码是：

'Retrieve Target Folder Path From User
  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

    With FldrPicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With

'In Case of Cancel
NextCode:
  myPath = myPath
  If myPath = "" Then GoTo ResetSettings

'Target File Extension (must include wildcard "*")
  myExtension = "LUZ*"

'Target Path with Ending Extention
  myFile = Dir(myPath & myExtension)

'Loop through each Excel file in folder
  Do While myFile <> ""
    'Set variable equal to opened workbook
      Set wb = Workbooks.Open(fileName:=myPath & myFile)

    'Add GEN_LU_ZN to column G1
    wb.Worksheets(1).Range("G1").Value = "GEN_LU_ZN"



    'Save and Close Workbook
      wb.Close SaveChanges:=True

    'Get next file name
      myFile = Dir
  Loop

'Message Box when tasks are completed
  MsgBox "Task Complete!"

ResetSettings:
  'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

从现在开始，我需要做的是从每个电子表格中复制两个特定的列，以“ GenLU”开头，然后将其粘贴到相应电子表格的工作表2中。

例如，需要将列C＆E从“ GenLU_Calgary_2008”复制到相应电子表格“ LUZ_Summary_Calgary_2015”的第二个表中。 代码需要以某种方式使用名称（在本例中为Calgary）匹配电子表格，并且需要对所有电子表格进行匹配。

很长的问题很抱歉，但是我希望有一些可以帮助VBA新手。 我已经搜索了很多，虽然我找到了要在工作表之间复制或在工作簿之间复制的代码，但是我在实现所需功能时遇到了麻烦。 任何帮助都感激不尽！

Answer 1

没有文件就很难进行测试，但是您可以在代码中尝试以下操作：

Dim i As Integer
Dim wb1 As Workbook, wb2 As Workbook
Dim MyAr() As String: MyAr = Split("Calgary,XXX,YYY", ",")

For i = LBound(MyAr) To UBound(MyAr)

    Do While myFile <> ""
        If myFile Like "GenLU" & "*" & MyAr(i) Then
            Set wb1 = Workbooks.Open(Filename:=myPath & myFile)
            Exit Do
        End If
    Loop

    Do While myFile <> ""
        If myFile Like "LUZ_Summary" & "*" & MyAr(i) And Not wb1 Is Nothing Then
            Set wb2 = Workbooks.Open(Filename:=myPath & myFile)
            wb2.Worksheets(1).Columns(3).Value = wb1.Worksheets(1).Columns(3).Value
            wb2.Worksheets(1).Columns(5).Value = wb1.Worksheets(1).Columns(5).Value
            wb1.Close
            wb2.Save
            wb2.Close
            Exit Do
        End If
    Loop

    Set wb1 = Nothing

Next i

请注意，您没有提供正在使用的工作表的信息，因此我假设它始终是Worksheets(1) 。 列C = Columns(3) 。 MyAr()是用于存储国家/地区的String数组。