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

我是VBA新手，正在撰写一个macros。 目的是迭代一个电子表格列表（我有两套保存在同一个目录中，每套都有一个特定的命名约定）。 一组命名为“GenLU_xx”，另一组命名为“LUZ_Summary_xx”。 每个名字中的'xx'是指一个名字，例如卡尔加里。 所以我会为卡尔加里（LUZ_Summary_Calgary＆GenLU_Calgary）提供两个不同的电子表格。

macros需要打开每个电子表格，以“LUZ”开头为G1添加一个值。 我通过修改我在这里find的代码完成了第一部分： http : //www.thespreadsheetguru.com/the-code-vault/2014/4/23/loop-through-all-excel-files-in-a-given -foldermacros要求用户确定电子表格存储的目录，然后以“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”中的第二张纸上。 该代码需要以某种方式匹配电子表格使用名称（在这种情况下，卡尔加里），它需要为所有的电子表格。

对不起，这个问题太长了，但我希望有人能帮助一个VBA newb。 我已经search了不less，而我已经find代码复制从工作表到工作簿或工作簿的工作簿，我很难实现我所需要的。 任何帮助都感激不尽！

Answer 1

在没有任何文件的情况下很难testing某些东西，但是可以尝试以下代码作为代码的一部分：

 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 

请注意，您没有提供正在处理的Worksheet的信息，所以我假定它始终是Worksheets(1) 。 列C = Columns(3) 。 MyAr()是存储国家的string数组。