我正在尝试使用主电子表格将多个工作表中的数据合并为一个。
但是，似乎我只能为连续列设置源范围，并且我想复制不同的列（例如 A、C 和 K）。
有人可以帮忙命令如何做到这一点吗？另外，我希望只要有数据（而不是指定单元格范围）就可以复制整个列，有人知道如何做到这一点吗？
这是我正在使用的代码（在线找到）：
Sub MergeAllDeliverables()
Dim SummarySheet As Worksheet
Dim FolderPath As String
Dim NRow As Long
Dim Filename As String
Dim WorkBk As Workbook
Dim SourceRange As Range
Dim DestRange As Range
' Create a new workbook and set a variable to the first sheet.
Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
' Modify this folder path to point to the files you want to use.
FolderPath = "C:Users..."
' NRow keeps track of where to insert new rows in the destination workbook.
NRow = 1
' Call Dir the first time, pointing it to all Excel files in the folder path.
Filename = Dir(FolderPath & "*.xl*")
' Loop until Dir returns an empty string.
Do While Filename <> ""
' Open a workbook in the folder
Set WorkBk = Workbooks.Open(FolderPath & Filename)
' Set the cell in column A to be the file name.
SummarySheet.Range("A" & NRow).Value = Filename
' Set the source range to be what you like.
' Modify this range for your workbooks.
' It can span multiple rows.
Set SourceRange = WorkBk.Worksheets(1).Range("a:1")
' Set the destination range to start at column B and
' be the same size as the source range.
Set DestRange = SummarySheet.Range("B" & NRow)
Set DestRange = DestRange.Resize(SourceRange.Rows.Count, _
SourceRange.Columns.Count)
' Copy over the values from the source to the destination.
DestRange.Value = SourceRange.Value
' Increase NRow so that we know where to copy data next.
NRow = NRow + DestRange.Rows.Count
' Close the source workbook without saving changes.
WorkBk.Close savechanges:=False
' Use Dir to get the next file name.
Filename = Dir()
Loop
' Call AutoFit on the destination sheet so that all
' data is readable.
SummarySheet.Columns.AutoFit
End Sub
您可以设置"多列"范围，如下所示
Set multiColRng = Range("C:C, G:H, K")
但
粘贴整个列的值可能很耗时（而且无用）
列可以有"孔"，即它们的第一个和最后一个非空白单元格之间的空白单元格
因此，仅粘贴"多列"范围内的非空白值会很有用
这带来了Range对象的Areas属性的问题，这既是解决方案（您必须通过它）也是目标的关注点（这有点棘手，至少对我来说是这样）
然后，您可能希望使用以下子：
Option Explicit
Sub PasteColumnsValues(multiColsRng As Range, destRng As Range)
Dim col As Long, row As Long, colsArea As Long, rowsArea As Long
With multiColsRng.Areas '<~~ consider "columns" areas in which columns range is divided
For colsArea = 1 To .count '<~~ loop through those "column" areas
With .Item(colsArea) '<~~ consider current "column" area
For col = 1 To .Columns.count '<~~ loop through all "real" (single) columns of which a single "column" area consists of
row = 1 '<~~ initialize pasting row index
With .Columns.Item(col).SpecialCells(xlCellTypeConstants, xlNumbers) '<~~ consider current "real" (single) column
For rowsArea = 1 To .Areas.count '<~~ loop through all areas of which a single "real" column consists of
With .Areas(rowsArea) '<~~ consider current area of the current "real" (single) column
destRng(row, colsArea + col - 1).Resize(.count).Value = .Value '<~~ paste current area values
row = row + .Rows.count '<~~ update pasting row index
End With
Next rowsArea
End With
Next col
End With
Next colsArea
End With
End Sub
可以按如下方式使用：
Sub main()
With ActiveSheet
PasteColumnsValues Range("C:C, G:H"), .Range("N1") '<~~ the 1st argument MUST be a "multiple column" Range
End With
End Sub
with .Range（） 你可以设置多个列 - 比如：
Dim rng As Range
Set rng = Sheets(1).Range("A1:A100, D3:D400")
而不是确切地指定这一点：
Dim rng As Range
Dim lastRow As Long, lastColumn As Long
For i = 1 To Rows.Count - 1
If IsEmpty(Cells(i, 1)) Then Exit For
Next i
Set rng = Range("A1:A" & i)
单元格 （i， 1） 中的 1 表示第一列 A。
对于每一列，您可以创建一个 For 循环来计算填充的单元格。
如果列中的填充单元格之间有空单元格 - 您必须走另一条路（用户的答案:)...
列 A 和 D 的示例：
For i = 1 To Rows.Count - 1
If IsEmpty(Cells(i, 1).Value) Then Exit For
Next i
For j = 1 To Rows.Count - 1
If IsEmpty(Cells(j, 4).Value) Then Exit For
Next j
Set rng = Range("A1:A" & i & ", D1:D" & j)