Question

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

有人可以帮我修改下面的宏吗？我在互联网上找到它，我根据自己的喜好进行了修改。但仍有改进空间。无论如何，除了以下情况外，它的效果非常好。

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

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

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

Tibor

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

End Sub

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

如果您需要检查每一行的特定单元格值，请使用以下内容。这将逐行检查不会说＆＃34;已关闭＆＃34;

的行。

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

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

2 个答案: