复制的数据未粘贴到目标工作簿中

Question

我有一个vba宏，它试图对一个工作簿中的数据进行一些简单的格式化，然后将格式化的数据粘贴到另一个工作簿中表格的底部。出于某种原因，我收到运行时错误'1004'：Range类的PasterSpecial方法在粘贴时失败，我不知道为什么。

prompt-behavior

Answer 1

将范围复制到范围

• 仔细调整常量（Const）部分中的值。
• 假设代码将在包含 RawData工作表。

提示

• 通常计算最后或首次使用的单元格（行，列） 从底部还是从右侧开始。如果您的数据在Source Range以下，我可能是错的。
• 如果可能的话，最好避免包含Select和Active的任何东西。
• 粘贴值时，很容易（最好）避免使用Copy（Paste）。

代码

Sub Add_Data()

    Const cSource As String = "RawData"   ' Source Worksheet Name
    Const cCols As String = "A:N"         ' Source Columns Range Address
    Const cFr As Long = 2                 ' Source/Target First Row Number

    Const cWbTarget As String = "Ongoing Report.xlsm"   ' Target Workbook Name
    Const cTarget As String = "Sheet1"    ' Target Worksheet Name
    Const cTgt As String = "A"            ' Target Column Range

    Dim rngS As Range   ' Source Range
    Dim rngT As Range   ' Target Range

    ' In Source Worksheet
    With ThisWorkbook.Worksheets(cSource)
        ' Insert column to the left of column B in raw data.
        .Columns("B:B").Insert Shift:=xlToRight, _
                CopyOrigin:=xlFormatFromLeftOrAbove
        ' In Source Columns Range
        With .Columns(cCols)
            ' Calculate and create a reference to Source First Column Last Used
            ' Cell.
            'Set rngS = .Cells(.Row, .Column).End(xlDown)
            Set rngS = .Cells(.Rows.Count, .Column).End(xlUp)
            ' Calculate and create a reference to Source Range.
            Set rngS = .Rows(cFr).Resize(rngS.Row - cFr + 1)
        End With
    End With

    ' In Target Worksheet
    With Workbooks(cWbTarget).Worksheets(cTarget)
        ' Remove filter from column B of ongoing report
        .ListObjects("OpenJobs_DATA").Range.AutoFilter Field:=2
        ' Calculate and create a reference to Target Column First Empty Cell.
        Set rngT = .Cells(.Rows.Count, cTgt).End(xlUp).Offset(1)
        ' Calculate and create a reference to Target Range i.e. adjust the size
        ' to be equal to the size of Source Range.
        Set rngT = rngT.Resize(rngS.Rows.Count, rngS.Columns.Count)
        ' Copy values from Source Range to Target Range.
        rngT = rngS.Value
        ' Filter column B of ongoing report to remove blanks
        .ListObjects("OpenJobs_DATA").Range.AutoFilter Field:=2, Criteria1:="<>"
    End With

End Sub

Answer 2

当您取消过滤目标工作簿中的表时，将丢失剪贴板数据。他们先取消过滤，然后复制原始范围。另外，几乎没有理由使用select。它可以减慢您的宏。

Sub Add_Data()
    Dim home As Worksheet: Set home = ActiveWorkbook.Sheets("sheet name 1")
    Dim dest As Worksheet: Set dest = Windows("Ongoing Report.xlsm").Sheets("sheet name 2")

    'Insert column to the left of column B in raw data
    home.Columns("B:B").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

    'Remove filter from column B of ongoing report
    dest.Sheets("sheet name here").ListObjects("OpenJobs_DATA").Range.AutoFilter Field:=2

    'Copy columns A-N in raw data
    home.Range("A2", Range("A2").SpecialCells(xlEnd).Copy

    'Paste data from raw data at bottom of ongoing report
    dest.Range("A" & dest.Range("A2").End(xlDown).Row + 1).PasteSpecial xlPasteValues

    'Filter column B of ongoing report to remove blanks
    Dest.ListObjects("OpenJobs_DATA").Range.AutoFilter Field:=2, Criteria1:="<>"
End Sub

未经我的手机测试，但希望这能为您指明正确的方向。