无法粘贴信息,因为复制区域和粘贴区域的大小和形状不同

时间:2015-06-09 09:30:02

标签: excel vba excel-vba

我有一个准备报告的excel宏。该宏每天使用,但今天已经抛出了上述错误。错误发生在给定代码的最后一行。有人遇到过这个问题吗? 宏绘制的第二个表(并且收到错误)已经变得非常大,这是问题的原因吗?

    Windows("Worldwide_Backlog.xlsm").Activate 'Save File as Worldwide_Backlog'
    Worksheets(3).Activate
        ActiveSheet.PivotTables("PivotTable1").PivotFields("SubFamily2"). _
         ClearAllFilters
        ActiveSheet.PivotTables("PivotTable1").PivotFields("SubFamily2").CurrentPage = _
         "DAS"
        ActiveSheet.PivotTables("PivotTable1").PivotFields("Product Family"). _
          ClearAllFilters
        ActiveSheet.PivotTables("PivotTable1").PivotFields("Product Family"). _
          CurrentPage = "REMI"

    'Clear Filters'

             ActiveSheet.PivotTables("PivotTable1").PivotFields("Age").ClearAllFilters



    'Copy and Paste Table into new Workbook'
              Range("A9").Select
              Selection.End(xlToRight).Select
              Selection.End(xlToLeft).Select
              Range(Selection, Selection.End(xlToRight)).Select
              Range(Selection, Selection.End(xlDown)).Select
              Selection.Copy
              Workbooks.Add
              ActiveSheet.Paste

     'Delete Grand Total from newly pasted table'

         Dim Firstrow As Long
         Dim Lastrow As Long
         Dim Lrow As Long
         Dim CalcMode As Long
         Dim ViewMode As Long

    With Application
         CalcMode = .Calculation
         .Calculation = xlCalculationManual
         .ScreenUpdating = False
    End With


        With ActiveSheet


         .Select


    ViewMode = ActiveWindow.View
    ActiveWindow.View = xlNormalView


    .DisplayPageBreaks = False

    Firstrow = .UsedRange.Cells(1).Row
    Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row


    For Lrow = Lastrow To Firstrow Step -1


        With .Cells(Lrow, "A")

            If Not IsError(.Value) Then

                If .Value = "Grand Total" Then .EntireRow.Delete


            End If

        End With

    Next Lrow

End With

ActiveWindow.View = ViewMode
With Application
    .ScreenUpdating = True
    .Calculation = CalcMode
End With



         Windows("Worldwide_Backlog.xlsm").Activate
         Worksheets(3).Activate
         ActiveSheet.PivotTables("PivotTable1").PivotFields("SubFamily2"). _
         ClearAllFilters
         ActiveSheet.PivotTables("PivotTable1").PivotFields("SubFamily2").CurrentPage = _
         "Ra"
         Range("A11").Select
         Application.CutCopyMode = False

         ActiveSheet.PivotTables("PivotTable1").PivotSelect "Order Number", xlButton, _
         True
         Range(Selection, Selection.End(xlToRight)).Select
         Range(Selection, Selection.End(xlDown)).Select
         Selection.Copy
         Workbooks.Add
         ActiveSheet.Paste




        'Delete Grand Total'

With Application
    CalcMode = .Calculation
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
End With


With ActiveSheet


    .Select


    ViewMode = ActiveWindow.View
    ActiveWindow.View = xlNormalView


    .DisplayPageBreaks = False


    Firstrow = .UsedRange.Cells(1).Row
    Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row


    For Lrow = Lastrow To Firstrow Step -1


        With .Cells(Lrow, "A")

            If Not IsError(.Value) Then

                If .Value = "Grand Total" Then .EntireRow.Delete


            End If

        End With

    Next Lrow

End With

ActiveWindow.View = ViewMode
With Application
    .ScreenUpdating = True
    .Calculation = CalcMode
End With


          Range("M1").Select
             ActiveCell.FormulaR1C1 = "Vlookup"
             Range("M2").Select
             ActiveCell.FormulaR1C1 = "=VLOOKUP(C[-12],[Book1]Sheet1!C1,1,0)"
             Range("L2").Select 'AutoFills'
                Selection.End(xlDown).Select
                ActiveCell.Offset(0, 1).Select
                Range(Selection, Selection.End(xlUp)).Select
                Selection.FillDown


             Columns("M:M").Select
             Selection.AutoFilter
             ActiveSheet.Range("$M$1:$M$21").AutoFilter Field:=1, Criteria1:="=#N/A", _
             Operator:=xlOr, Criteria2:="="
             Range("A2").Select
             Range(Selection, Selection.End(xlToRight)).Select
             Range(Selection, Selection.End(xlDown)).Select
             Selection.Copy
             Windows("Book1").Activate
             ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1).Select 'Uses first blank cell'
             ActiveSheet.Paste

2 个答案:

答案 0 :(得分:0)

表单数据格式错误。 工作表中有一些行将一些列合并为一行,从而减少了这些行的列数。 这就是为什么它抱怨尺寸差异。

将数据复制到记事本++并检查格式问题。

答案 1 :(得分:-2)

目标文件处于兼容模式。 转到文件>信息转换>保存。 这将解决您的问题。