Question

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

例如：

练习册一（A1：A5）将复制到主工作簿（A1：A5）练习册二（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

这样做是每次都转到最后一列，然后一直向左移动，找到包含实际数据的最后一列，然后将其偏移1列。在该列的第1行中，将输入工作簿的名称。数据将从第2行开始输入。

Answer 2

使用ThisWorkbook.Sheets（1）
.Range（＆＃34; A＆＃34;＆amp; .Columns.Count）.End（xlToLeft），操作：= xlAdd，SkipBlanks：= True

结束

你需要把它放在＆＃34; For＆＃34;循环以从所有Excel工作表/工作簿中提取数据。

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

2 个答案: