paste类的RangeSpecial方法失败

时间：2017-01-04 09:38:13

标签： excel vba excel-vba

有时候我没有获得Excel VBA，我只是将数据从一张纸复制到另一张，但我收到错误：

  

Range类的pasteSpecial方法失败

我从互联网上的来源复制一些日期，将其粘贴到“临时”表格中，删除一些列，进行一些计算，然后将其粘贴到“最终”表格中。 这是我的代码：

    Sub copying()
'
' copying Macro
'
Application.Calculation = xlManual
  Application.ScreenUpdating = False
  Application.EnableEvents = False

  Dim tempSheet As Worksheet

Set tempSheet = ThisWorkbook.Sheets("temporary")

tempSheet.Activate



    tempSheet.Cells.ClearFormats

    tempSheet.Cells(4, 1).Select
    ActiveSheet.Paste


    Columns(4).Select
    Selection.Cut
    Columns(3).Select
    ActiveSheet.Paste

     Columns(6).Select
    Selection.Cut
    Columns(4).Select
    ActiveSheet.Paste

    '
     Columns(7).Select
    Selection.Cut
    Columns(5).Select
    ActiveSheet.Paste

     Columns(8).Select
     Selection.ClearFormats


    Columns(8).Select
    Selection.Cut
    Columns(6).Select
    ActiveSheet.Paste


      Columns(9).Select
    Selection.Cut
    Columns(7).Select
    ActiveSheet.Paste

      Columns(19).Select
    Selection.Cut
    Columns(8).Select
    ActiveSheet.Paste





      Columns(21).Select
    Selection.Cut
    Columns(9).Select
    ActiveSheet.Paste



    Columns(10).Select
     Selection.ClearFormats
     Selection.ClearContents


    Columns(73).Select
    Selection.Cut
    Columns(11).Select
    ActiveSheet.Paste

      Columns(23).Select
    Selection.Cut
    Columns(12).Select
    ActiveSheet.Paste

      Columns(25).Select
    Selection.Cut
    Columns(13).Select
    ActiveSheet.Paste


      Columns(14).Select
     Selection.ClearFormats
     Selection.ClearContents





      Columns(37).Select
    Selection.Cut
    Columns(21).Select
    ActiveSheet.Paste



      Columns(22).Select
     Selection.ClearFormats
     Selection.ClearContents



         Columns(76).Select
    Selection.Cut
    Columns(23).Select
    ActiveSheet.Paste



    Range("X1").Select

    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select

    Selection.ClearContents


Columns("E:E").Select
    Selection.NumberFormat = "m/d/yyyy"

    Columns("F:F").Select
    Selection.NumberFormat = "m/d/yyyy"

      Columns("L:L").Select
    Selection.NumberFormat = "0.00"


      Columns("H:H").Select
    Selection.NumberFormat = "0.00"

     Columns(8).Select
    Selection.NumberFormat = "0.00"

     Columns(9).Select
    Selection.NumberFormat = "0.00"

     Columns(10).Select
    Selection.NumberFormat = "0.00"




     Columns(12).Select
    Selection.NumberFormat = "0.00"

     Columns(13).Select
    Selection.NumberFormat = "0.00"

     Columns(14).Select
    Selection.NumberFormat = "0.00"





     Columns(16).Select
    Selection.NumberFormat = "0.00"

     Columns(17).Select
    Selection.NumberFormat = "0.00"

     Columns(18).Select
    Selection.NumberFormat = "0.00"


     Columns(20).Select
    Selection.NumberFormat = "0.00"

     Columns(21).Select
    Selection.NumberFormat = "0.00"

     Columns(22).Select
    Selection.NumberFormat = "0.00"


   ' Debug.Print Cells(10, 2)
 lrow = Cells(Rows.Count, "C").End(xlUp).row


 'debig.Print Cells(2, 9).Value
    Dim i As Integer
    For i = 5 To lrow
    ' calculating the UM = NS - CoS


    'for SDP3
    If (Cells(i, 8).Value = "Missing Data" Or Cells(i, 9).Value = "Missing Data") Then
    Cells(i, 10).Value = "Missing Data"
    Else
    Cells(i, 10).Value = Cells(i, 8).Value - Cells(i, 9).Value
    End If

    'TG2
If (Cells(i, 12).Value = "Missing Data" Or Cells(i, 13).Value = "Missing Data") Then
    Cells(i, 14).Value = "Missing Data"
    Else

 Cells(i, 14).Value = Cells(i, 12).Value - Cells(i, 13).Value
   End If

' PTD
If (Cells(i, 16).Value = "Missing Data" Or Cells(i, 17).Value = "Missing Data") Then
    Cells(i, 18).Value = "Missing Data"
    Else
   Cells(i, 18).Value = Cells(i, 16).Value - Cells(i, 17).Value
    End If

' PTE
If (Cells(i, 20).Value = "Missing Data" Or Cells(i, 21).Value = "Missing Data") Then
    Cells(i, 22).Value = "Missing Data"
    Else
   Cells(i, 22).Value = Cells(i, 20).Value - Cells(i, 21).Value
    End If

'%UM DEVIATION = UM% of the second - UM%
'SDP3 --- TG2
If (Cells(i, "K").Value = "N/A" Or Cells(i, "O").Value = "N/A") Then
    Cells(i, "Y").Value = "N/A"
    Else
   Cells(i, "Y").Value = Cells(i, "O").Value - Cells(i, "K").Value
    End If

'SDP3 --- PTE
If (Cells(i, "K").Value = "N/A" Or Cells(i, "S").Value = "N/A") Then
    Cells(i, "AB").Value = "N/A"
    Else
   Cells(i, "AB").Value = Cells(i, "S").Value - Cells(i, "K").Value
    End If


'TG2 -- PTE
If (Cells(i, "O").Value = "N/A" Or Cells(i, "S").Value = "N/A") Then
    Cells(i, "AE").Value = "N/A"
    Else
   Cells(i, "AE").Value = Cells(i, "S").Value - Cells(i, "O").Value
    End If


' DEV MSEK if (UM% of both < 0 -> %UM * NS of the second)
'SDP3 --- TG2
If (Cells(i, "Y").Value = "N/A" Or Cells(i, "L").Value = "N/A") Then
Cells(i, "X").Value = "N/A"
Else
    If (Cells(i, "Y").Value < 0) Then

    Cells(i, "X").Value = 0
    Else
     Cells(i, "X").Value = Cells(i, "Y").Value * Cells(i, "L").Value

    End If

End If




'SDP3 --- PTE
If (Cells(i, "AB").Value = "N/A" Or Cells(i, "P").Value = "N/A") Then
Cells(i, "AA").Value = "N/A"
Else
    If (Cells(i, "AB").Value < 0) Then

    Cells(i, "AA").Value = 0
    Else
     Cells(i, "AA").Value = Cells(i, "AB").Value * Cells(i, "P").Value

    End If

End If





'TG2 -- PTE
If (Cells(i, "AE").Value = "N/A" Or Cells(i, "P").Value = "N/A") Then
Cells(i, "AD").Value = "N/A"
Else
    If (Cells(i, "AE").Value < 0) Then

    Cells(i, "AD").Value = 0
    Else
     Cells(i, "AD").Value = Cells(i, "AE").Value * Cells(i, "P").Value

    End If

End If

' indicators Y,AB,AE   - > Z, AC , AF
If (Cells(i, "Y").Value = "N/A") Then
Cells(i, "Z").Value = "N/A"
Else
    If (Cells(i, "Y").Value < 0) Then
    Cells(i, "Z").Value = Chr(226)
    Cells(i, "Z").Font.Name = "Wingdings"
    Cells(i, "Z").Font.Color = vbRed
    ElseIf (Cells(i, "Y").Value > 0) Then
    Cells(i, "Z").Value = Chr(225)
    Cells(i, "Z").Font.Name = "Wingdings"
    Cells(i, "Z").Font.Color = vbGreen
    Else
    Cells(i, "Z").Value = "-"
    End If
End If

If (Cells(i, "AB").Value = "N/A") Then
Cells(i, "AC").Value = "N/A"
Else
    If (Cells(i, "AB").Value < 0) Then
    Cells(i, "AC").Value = Chr(226)
    Cells(i, "AC").Font.Name = "Wingdings"
    Cells(i, "AC").Font.Color = vbRed
    ElseIf (Cells(i, "AB").Value > 0) Then
    Cells(i, "AC").Value = Chr(225)
    Cells(i, "AC").Font.Name = "Wingdings"
    Cells(i, "AC").Font.Color = vbGreen
    Else
    Cells(i, "AC").Value = "-"
    End If
End If


If (Cells(i, "AE").Value = "N/A") Then
Cells(i, "AF").Value = "N/A"
Else
    If (Cells(i, "AE").Value < 0) Then
    Cells(i, "AF").Value = Chr(226)
    Cells(i, "AF").Font.Name = "Wingdings"
    Cells(i, "AF").Font.Color = vbRed
    ElseIf (Cells(i, "AE").Value > 0) Then
    Cells(i, "AF").Value = Chr(225)
    Cells(i, "AF").Font.Name = "Wingdings"
    Cells(i, "AF").Font.Color = vbGreen
    Else
    Cells(i, "AF").Value = "-"
    End If
End If
Next
    ' format the columns
Columns("Y:Y").Select
    Selection.NumberFormat = "0.00%"


    Columns("AB:AB").Select
    Selection.NumberFormat = "0.00%"


    Columns("AE:AE").Select
    Selection.NumberFormat = "0.00%"

    ActiveSheet.Range("A5:AF" & lrow).Copy


    ThisWorkbook.Worksheets("final").Activate
    Application.Wait (Now + TimeValue("0:00:01"))
     lrowFinal = Cells(Rows.Count, "C").End(xlUp).row
     If lrowFinal < 4 Then
     lrowFinal = 4
     End If


     ThisWorkbook.Sheets("final").Range("C3:AH" & lrowFinal).ClearContents




     ThisWorkbook.Sheets("final").Range("C4").PasteSpecial (Excel.XlPasteType.xlPasteAll)
    'ActiveSheet.PasteSpecial Paste:=xlPasteValues
    'PasteAsLocalFormula

    Application.CutCopyMode = False

With ActiveSheet

        .AutoFilterMode = False

        .Range("C4").CurrentRegion.AutoFilter

    End With


     Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
  Application.EnableEvents = True
End Sub

错误发生在最后几行：

  

ThisWorkbook.Sheets（“final”）。Range（“C4”）。PasteSpecial（Excel.XlPasteType.xlPasteAll）

我做错了什么，我尝试了很多修复，但都没有用

编辑：

我将复制代码更改为以下内容，但我仍然收到错误：

    ThisWorkbook.Sheets("final").Activate

     Application.Wait (Now + TimeValue("0:00:01"))
 lrowFinal = Cells(Rows.Count, "C").End(xlUp).row
 If lrowFinal < 4 Then
 lrowFinal = 4
 End If


ActiveSheet.Range("C3:AH" & lrowFinal).ClearContents

Sheets("temporary").Activate

ActiveSheet.Range("A5:AF" & lrow).Copy


ThisWorkbook.Worksheets("final").Activate


 ActiveSheet.Range("C4").PasteSpecial xlPasteAll

0 个答案:

没有答案
相关问题
最新问题