将一个文件夹中的多个文件复制到一个主文件中

我是创buildmacros的新手。 只为其中的5个具体问题创build。

有人可以帮我修改下面的macros吗？ 我在互联网上发现它，我把它修改成我的喜好。 但是还有改进的空间。 反正它除了下面的工作完美。

文件夹中会有很多文件。 每个文件都包含一个名为“PIVOT”的选项卡，其格式相同，但数据量不同。

在“PIVOT”选项卡中的范围是从A到AM列。 他们从第15行开始。我只需要那些没有写入“closures”指示的行（状态列在AJ列中）。 我希望所有这些行都被复制到一个主文件下。 行数差异很大 – 如0到200，具体取决于未清项目。

其次，有人能告诉我一本书，可以购买，以便我可以发展我的知识吗？ 感谢您的帮助！

蒂博尔

Sub Import_to_Master（）Dim sFolder As String Dim sFile As String Dim wbD As Workbook，wbS As Workbook

Application.ScreenUpdating = False Set wbS = ThisWorkbook sFolder = wbS.Path & "\" sFile = Dir(sFolder) Do While sFile <> "" If sFile <> wbS.Name Then Set wbD = Workbooks.Open(sFolder & sFile) 'open the file; add condition to ' >>>>>> Adapt this part wbD.Sheets("PIVOT").Range("A15:AM26").Copy wbS.Activate Sheets("Template").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues Application.CutCopyMode = False ' >>>>>> wbD.Close savechanges:=True 'close without saving End If sFile = Dir 'next file Loop Application.ScreenUpdating = True 

结束小组

Answer 1

如果您需要检查每行的某个单元格值，请使用类似于以下内容的内容。 这将循环逐行检查不说“已closures”的行。

 Dim sFolder As String, sFile As String, wbD As Workbook, wbS As Workbook Dim lastRowS As Integer, lastRowD As Integer Application.ScreenUpdating = False Set wbS = ThisWorkbook sFolder = wbS.Path & "\" sFile = Dir(sFolder lastRowS = Sheets("Template").Range("A" & Rows.Count).End(xlUp).Row + 1 Do While sFile <> "" If sFile <> wbS.Name Then Set wbD = Workbooks.Open(sFolder & sFile) 'open the file; add condition to lastRowD = wbD.Sheets("PIVOT").Range("A" & Rows.Count).End(xlUp).Row For i = 15 To lastRowD If Cells(i, 3) <> "Closed" Then 'change 3 to whatever column number has Closed in wbD.Sheets("PIVOT").Rows(i).EntireRow.Copy wbS.Sheets("Template").Cells(lastRowS, 1).PasteSpecial xlPasteValues lastRowS = lastRowS + 1 End If Next i Application.CutCopyMode = False ' >>>>>> wbD.Close savechanges:=False 'close without saving End If sFile = Dir 'next file Loop Application.ScreenUpdating = True End Sub 

Answer 2

你可能会在这之后：

  ' >>>>>> Adapted part With wbD.Sheets("PIVOT") With .Range("AM14", .Cells(.Rows.count, 1).End(xlUp)) '<--| reference its column "A:AM" range from row 14 down to column "A" last not empty row .AutoFilter Field:=36, Criteria1:="<>closed" '<--| filter referenced range on its 36th column (ie column "AJ") with values different from "closed" If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then .Resize(.Rows.count - 1).Offset(1).SpecialCells(xlCellTypeVisible).Copy Sheets("Template").Range("A" & Rows.count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues Application.CutCopyMode = False End If End With .AutoFilterMode = False End With ' >>>>>>