Question

我是VBA的新手，正在写一个宏。目的是遍历电子表格列表（我在同一目录中保存了两个集合，每个集合都有一个特定的命名约定）。一组命名为＆＃34; GenLU_xx＆＃34;另一个名为＆＃34; LUZ_Summary_xx＆＃34;。＆＃39; xx＆＃39;在每个名称中引用一个名称，例如卡尔加里。所以我会为卡尔加里提供两种不同的电子表格（LUZ_Summary_Calgary＆amp; GenLU_Calgary）。

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

'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

从这一点开始我需要做的是从每个电子表格中复制两个特定列，以＆＃34; GenLU＆＃34;并将它们粘贴到相应电子表格的表2中。

例如C＆amp; C列E需要从＆＃34; GenLU_Calgary_2008＆＃34;到相应电子表格中的第二张表格＆＃34; LUZ_Summary_Calgary_2015＆＃34;。代码需要以某种方式使用名称（在本例中为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数组。

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

1 个答案: