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() 是一个用于存储国家/地区的字符串数组。