首页 文章

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

提问于
浏览 次
0

我需要从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
excel vba excel-vba

2 回答

  • 1

    正如上面的评论中所述，我会尽力说清楚它们的含义 .

    First ，你有一个拼写错误， PasteSpecial x1PasteValues 应该 PasteSpecial xlPasteValues （这是"l"不是"1"） .

    Second ，第一次进入循环（ For Each subWs In ThisWorkbook.Worksheets ），因为你没有将 subColumn 初始化为任何值，它是 0 . 所以当你尝试粘贴 targetWs.Cells(2, subColumn) 时，第一次进入循环它实际上是 targetWs.Cells(2, 0) ，因为没有列 0 ，你得到这个"lovely"运行时错误＃1004 .

    回复于
  • 0

    复制每张纸的范围

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

    回复于

相关问题