将多个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 

代码工作正常，但我坚持与信息的复制相关的问题，这是这行代码：

  .Range("A" & startrow & ":AQ" & lastrow).Copy 

我需要改变这个，以便考虑到两个范围。 这些列是“B：AD”和“AF：AQ”，但我不知道如何做到这一点。

我只是想知道有人可能会看看这个，请提供一些指导我如何去解决这个问题。

非常感谢和亲切的问候

Answer 1

在所有以下我假设你确实不希望列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 

如果你希望它粘贴在它之间的空间，那么你可以简单地r3pepeat复制和粘贴线：

  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