Vba 将多个Excel工作表合并到摘要工作表中

不知是否有人能帮助我

我使用下面的代码允许用户从多个Excel工作簿复制数据，并将数据合并到汇总表中

Sub Merge()
        Dim DestWB As Workbook, WB As Workbook, WS As Worksheet, SourceSheet As String

        Set DestWB = ActiveWorkbook
        SourceSheet = "Input"
        startrow = 7
        FileNames = Application.GetOpenFilename( _
        filefilter:="Excel Files (*.xls*),*.xls*", _
        Title:="Select the workbooks to merge.", MultiSelect:=True)
        If IsArray(FileNames) = False Then
            If FileNames = False Then
                Exit Sub
            End If
        End If
        For n = LBound(FileNames) To UBound(FileNames)
            Set WB = Workbooks.Open(Filename:=FileNames(n), ReadOnly:=True)
            For Each WS In WB.Worksheets
                If WS.Name = SourceSheet Then
                    With WS
                        If .UsedRange.Cells.Count > 1 Then
                            dr = DestWB.Worksheets("Input").Range("C" & Rows.Count).End(xlUp).Row + 1
                            lastrow = .Range("C" & Rows.Count).End(xlUp).Row
                            For j = lastrow To startrow Step -1
                                If Range("E" & j) <> "Requirements Manager" And Range("E" & j) <> "R & D Lead" And Range("E" & j) <> "Technical" And Range("E" & j) <> "Analyst" Then Rows(j).Delete
                            Next
                            lastrow = .Range("C" & Rows.Count).End(xlUp).Row
                            If lastrow >= startrow Then
                                .Range("A" & startrow & ":AQ" & lastrow).Copy
                                DestWB.Worksheets("Input").Cells(dr, "A").PasteSpecial xlValues
                            End If
                        End If
                    End With
                    Exit For
                End If
            Next WS
            WB.Close savechanges:=False
        Next n
    End Sub

我需要改变它，使它考虑两个范围。这是B:AD和AF:AQ列，但我不知道如何做到这一点

我只是想知道是否有人可以看看这一点，并提供一些指导，我可以如何着手解决这个问题

---

非常感谢并致以亲切的问候

在下文中，我假设您确实不希望将A列复制到目标工作簿和工作表中

您可以使用Union一次复制粘贴它，粘贴时不会反映其间的任何列：

                        If lastrow >= startrow Then
                            Union(.Range("B" & startrow & ":AD" & lastrow), .Range("AF" & startrow & ":AQ" & lastrow).Copy
                            DestWB.Worksheets("Input").Cells(dr, "B").PasteSpecial xlValues
                        End If

如果您希望在粘贴时在其之间留出空间，则只需复制并粘贴行：

                        If lastrow >= startrow Then
                            .Range("B" & startrow & ":AD" & lastrow).Copy
                            DestWB.Worksheets("Input").Cells(dr, "B").PasteSpecial xlValues
                            .Range("AF" & startrow & ":AQ" & lastrow).Copy
                            DestWB.Worksheets("Input").Cells(dr, "AF").PasteSpecial xlValues
                        End If

---

您好，非常感谢您抽出时间回复我的帖子。我选择了第二个选项，效果非常好！致以最良好和亲切的问候

                        If lastrow >= startrow Then
                            .Range("B" & startrow & ":AD" & lastrow).Copy
                            DestWB.Worksheets("Input").Cells(dr, "B").PasteSpecial xlValues
                            .Range("AF" & startrow & ":AQ" & lastrow).Copy
                            DestWB.Worksheets("Input").Cells(dr, "AF").PasteSpecial xlValues
                        End If