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

Question

我是创建宏的新手。仅针对特定问题创建了其中的 5 个。

有人可以帮我修改下面的宏吗？我在互联网上找到它，我根据自己的喜好对其进行了修改。但仍有改进的余地。无论如何，除了以下内容外，它都可以正常工作。

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

PIVOT 选项卡中的范围是从 A 到 AM 列。它们从第 15 行开始。我只需要那些没有写“关闭”指示的行（状态列在 AJ 列中）。我希望将所有这些行复制到彼此下的主文件中。行数变化很大 - 例如 0 到 200，具体取决于打开的项目。

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

提伯尔

子 Import_to_Master() 将 sFolder 变暗为字符串 将 sFile 作为字符串变暗 将 wbD 调暗为工作簿，将 wbS 调暗为工作簿

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

你可能在这之后：

        ' >>>>>> 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 (i.e. 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
        ' >>>>>>

Answer 2

如果您需要检查每一行的某个单元格值，请使用以下内容。这将逐行循环检查未显示“已关闭”的行。

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