Скопированные данные не вставляются в целевую книгу

Question

У меня есть макрос vba, который пытается выполнить небольшое форматирование данных в одной книге, а затем вставьте отформатированные данные в конец таблицы в другой книге. По какой-то причине я получаю сообщение об ошибке «1004» во время выполнения: метод PasterSpecial класса Range завершился неудачно при вставке, и я не могу понять, почему.

Sub Add_Data()
'
' Add_Data Macro
'

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

' Copy columns A-N in raw data
    Range("A2").Select
    Selection.End(xlDown).Select
    Range("A2:N" & ActiveCell.Row).Select
    Selection.Copy

' Remove filter from column B of ongoing report
    Windows("Ongoing Report.xlsm").Activate
    ActiveSheet.ListObjects("OpenJobs_DATA").Range.AutoFilter Field:=2

' Paste data from raw data at bottom of ongoing report
    Range("A2").Select
    Selection.End(xlDown).Select
    Range("A" & ActiveCell.Row + 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

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

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

Не проверено с моего мобильного, но надеюсь, что это направит вас в правильном направлении.