将单元格从多个工作簿复制到单个工作表

我想从多个工作簿中提取列A1：A5，并将其复制到一个工作表中。 将每个工作簿复制到相邻的列中。

例如：

工作簿1（A1：A5）将复制到主工作簿（A1：A5）工作簿2（A1：A5）将复制到主工作簿（B1：B：5）

我有这个代码，总结所有的价值观。

Sub SUM_Workbooks() Dim FileNameXls, f Dim wb As Workbook, i As Integer FileNameXls = Application.GetOpenFilename(filefilter:="Excel Files, *.xls*", MultiSelect:=True) If Not IsArray(FileNameXls) Then Exit Sub Application.ScreenUpdating = False For Each f In FileNameXls Set wb = Workbooks.Open(f) Dim rngPaste As Range With ThisWorkbook.Sheets(1) Set rngPaste = .Range("A" & .Columns.Count).End(xlToLeft).Offset(, 1) End With rngPaste.Value = wb.Name wb.Worksheets("Page 3").Range("P18:P22").Copy rngPaste.Offset(1).PasteSpecial Paste:=xlPasteValues wb.Close SaveChanges:=False Next f Application.CutCopyMode = False Application.ScreenUpdating = True End Sub 

我需要的是将工作簿中的值粘贴到相邻的列中。

Answer 1

改变这一行：

 ThisWorkbook.Sheets(1).Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd, SkipBlanks:=True, Transpose:=False 

到这一点的代码：

 For Each f In FileNameXls Set wb = Workbooks.Open(f) Dim rngPaste as Range With ThisWorkbook.Sheets(1) Set rngPaste = .Range("A" & .columns.Count).End(xlToLeft).Offset(,1) End With rngPaste.Value = wb.Name wb.Worksheets("Page 3").Range("P18:P22").Copy rngPaste.Offset(1).PasteSpecial Paste:=xlPasteValues wb.Close SaveChanges:=False Next f 

这将做的是每次到最后一列，然后一直移动到左边find实际数据的最后一列，然后偏移1列。 在该列的第1行中，将input工作簿的名称。 数据将从第2行开始input。

Answer 2

有了ThisWorkbook.Sheets（1）
.Range（“A”＆.Columns.Count）.End（xlToLeft），操作：= xlAdd，SkipBlanks：= True
结束

---

你需要把它放在“For”循环之间，以便从所有的Excel表格/工作簿中提取数据。