Question

我需要从excel文件的所有工作表的特定列复制数据，并将其粘贴到每个主题的特定工作表上。将name命名为列的第一行（也是工作表名称）及其下面的数据。

问题是我得到了运行时错误＆＃39; 1004＆＃39;：

应用程序定义或对象定义的错误

行：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

Answer 1

正如上面的评论所述，我会尽力说明它们的意思。

首先，你有一个错字，PasteSpecial x1PasteValues应该是PasteSpecial xlPasteValues（它是“l”不是“1”）。

第二次 ，首次进入循环（For Each subWs In ThisWorkbook.Worksheets），因为您尚未将subColumn初始化为任何值，它是{ {1}}。所以当你尝试粘贴0时，第一次进入循环它实际上是targetWs.Cells(2, subColumn)，因为没有列targetWs.Cells(2, 0)，你会得到这个“可爱的”运行时错误＃1004

Answer 2

复制每张纸的范围

注意：此示例使用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

https://www.rondebruin.nl/win/s3/win002.htm

从Excel文件中的所有工作表的列复制数据并将其粘贴到一个工作表中

2 个答案: