从Excel文件中的所有工作表的列中复制数据并将其粘贴到一个工作表中
我需要从excel文件的所有工作表的特定列中复制数据，并将其粘贴到具体表格中，每个主题的名称作为列的第一行（也是表格名称）及其下面的数据。
问题是我得到运行时错误'1004'：
应用程序定义或对象定义的错误
在行： targetWs.Cells(2, subColumn).PasteSpecial x1PasteValues
Sub Data() ' ' Data Macro 'assign varaible to subject worksheet and target worksheet Dim subWs As Worksheet Dim targetWs As Worksheet 'set subject sheet and target sheet Set targetWs = ActiveWorkbook.Sheets("Sheet1") 'Loop through all worksheets 'not really sure if I'm doing this right 'Copy subject name; paste to target sheet Rows(1).Insert Dim i As Integer For i = 1 To Sheets.Count Cells(1, i) = Sheets(i).Name Next i 'Loop through all worksheets 'not really sure if I'm doing this right For Each subWs In ThisWorkbook.Worksheets 'Copy subject data; paste to target sheet subWs.Range("B2:B242").Copy targetWs.Cells(2, subColumn).PasteSpecial x1PasteValues subColumn = subColumn + 1 Next subWs End Sub
正如上面的评论所述，我会尽力说清楚他们的意思。
首先 ，你有一个错字， PasteSpecial x1PasteValues应该是PasteSpecial xlPasteValues （它是一个“l”而不是“1”）。
其次 ，第一次进入循环（ For Each subWs In ThisWorkbook.Worksheets循环），由于您尚未将子subColumn初始化为任何值，因此它为0 。 所以当你尝试粘贴targetWs.Cells(2, subColumn) ，你第一次进入循环它实际上是targetWs.Cells(2, 0) ，因为没有第0列，你会得到这个“可爱的”运行时错误＃1004。
复制每张纸的范围
注意：本示例使用LastRow函数此示例复制每个工作表中的范围A1：G1。
改变这个代码行的范围
'Fill in the range that you want to copy Set CopyRng = sh.Range("A1:G1") 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 'Delete the sheet "RDBMergeSheet" if it exist Application.DisplayAlerts = False On Error Resume Next ActiveWorkbook.Worksheets("RDBMergeSheet").Delete On Error GoTo 0 Application.DisplayAlerts = True 'Add a worksheet with the name "RDBMergeSheet" Set DestSh = ActiveWorkbook.Worksheets.Add DestSh.Name = "RDBMergeSheet" 'loop through all worksheets and copy the data to the DestSh For Each sh In ActiveWorkbook.Worksheets If sh.Name <> DestSh.Name Then 'Find the last row with data on the DestSh Last = LastRow(DestSh) 'Fill in the range that you want to copy Set CopyRng = sh.Range("A1:G1") 'Test if there enough rows in the DestSh to copy all the data If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then MsgBox "There are not enough rows in the Destsh" GoTo ExitTheSub End If 'This example copies values/formats, if you only want to copy the 'values or want to copy everything look at the example below this macro CopyRng.Copy With DestSh.Cells(Last + 1, "A") .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats Application.CutCopyMode = False End With 'Optional: This will copy the sheet name in the H column DestSh.Cells(Last + 1, "H").Resize(CopyRng.Rows.Count).Value = sh.Name End If Next ExitTheSub: Application.Goto DestSh.Cells(1) 'AutoFit the column width in the DestSh sheet DestSh.Columns.AutoFit With Application .ScreenUpdating = True .EnableEvents = True End With End Sub