我正在使用我在Google上找到的一些代码。我正在尝试在多张纸上复制数据,并将其粘贴到摘要表中。
我想将A23和H8:S8中的数据复制到摘要表上的空白行。 A23
列位于A
列中,H8:S23
位于H
到S
列中。
这是我所拥有的,虽然它不起作用。
Sub CopyRangeFromMultiWorksheets()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim CopyRng As Range
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
' Set Summary Worksheet.
Set DestSh = ActiveWorkbook.Worksheets("Tab_Upload")
' Loop through all worksheets and copy the data to the
' summary worksheet.
For Each sh In ActiveWorkbook.Worksheets
If LCase(Left(sh.Name, 1)) = "_" Then
' Find the last row with data on the summary worksheet.
Last = ActiveSheet.[a65536].End(xlUp).Row
' Specify the range to place the data.
Set CopyRng = sh.Range("H8:S8, A23")
' This statement copies values and formats from each
' worksheet.
CopyRng.Copy
With DestSh.Cells(Last + 1, "A")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With
End If
Next
ExitTheSub:
Application.Goto DestSh.Cells(1)
' AutoFit the column width in the summary sheet.
DestSh.Columns.AutoFit
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
答案 0 :(得分:0)
我尝试设置它,当我只是手动选择并尝试复制两个范围时,我得到一个“该命令不能用于多个选择”。但是,如果两个或多个范围具有相同的列数,则没问题。我想这是因为它们的尺寸不同VBA不能很好地处理这些尺寸。尝试逐个进行,如下:
Option Explicit
Private Sub DoStuff()
Dim ws As Worksheet
Dim summary As Worksheet
Dim rng As Range
Set summary = ThisWorkbook.Sheets("Sheet4")
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> summary.Name Then
ws.Range("A1").Copy summary.Range("A" & summary.Range("A" & summary.Rows.Count).End(xlUp).Row + 1)
ws.Range("C1:D4").Copy summary.Range("A" & summary.Range("A" & summary.Rows.Count).End(xlUp).Row + 1)
End If
Next ws
End Sub
已编辑,如果复制多个范围,则必须具有相同的列数