Question

我现在使用的任何粘贴方法都有点麻烦。必须剪切并粘贴到另一张纸上的数据，但我不确定我缺少什么。

此处发生错误，在评论“HERE”之后不久：

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

完整代码可以在下面找到，感谢任何回复。

    Option Explicit
Public Sub Workbook_Open()
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim wb As Variant
Dim wsName As Variant
Dim blastrow As Variant
Dim flastrow As Variant
Dim lastrow As Variant


    ActiveWorkbook.Sheets("combined").Select

   Range("A1:U9999").ClearContents

   Dim MyObj As Object, MySource As Object, file As Variant
   file = Dir("G:\BS\Josh Whitfield\Credit_Chasing\NEW PROCESS\")
   'file level loop
   While (file <> "")
    If InStr(file, ".xlsx") > 0 Then
    Workbooks.Open "G:\BS\Josh Whitfield\Credit_Chasing\NEW PROCESS\" & file
    wb = ActiveWorkbook.Name
    'ws = ActiveSheet.Name

    Dim ws As Worksheet
    'worksheet/tab level loop
    For Each ws In ActiveWorkbook.Worksheets
            ws.Activate
            wsName = ws.Name

            'andrew code (09/12/2015)
            blastrow = Workbooks("Copy of merge.xlsb").Worksheets("Combined").Range("A" & Rows.Count).End(xlUp).Row + 1
            If blastrow = 2 Then blastrow = 1
            Workbooks("Copy of merge.xlsb").Worksheets("Combined").Range("A" & blastrow & ":XFD" & blastrow).Value = _
                Workbooks(wb).Worksheets(wsName).Range("A1:XFD1").Value


        lastrow = Range("A" & Rows.Count).End(xlUp).Row

        'finding status column
        Range("M1").Select
        Do Until ActiveCell.Value = "Status" Or ActiveCell.Column > 100
            If Range("A2") = "" Then
                GoTo there
            End If

            ActiveCell.Offset(0, 1).Select
    Loop

        'looping through
    Do Until ActiveCell.Row > lastrow
        If ActiveCell.Value = "Solved" Then 'HERE!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

    wb = ActiveWorkbook.Name
    wb = Replace(wb, ".xlsx", "")

        ActiveCell.EntireRow.Cut
        Workbooks("copy of merge.xlsb").Activate

    'find matching company
    Range("E1").Select
    While ActiveCell.Value <> "CoName"
        ActiveCell.Offset(0, 1).Select
    Wend

    Do Until ActiveCell.Value = wb
        ActiveCell.Offset(1, 0).Select
        If ActiveCell.Value = "" Then
            ActiveCell.EntireRow.Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        End If
    Loop

    'first cell in row select
    ActiveSheet.Cells(ActiveCell.Row, 1).Select

    'find matching ws
    If ws = "Be Wiser" Then
        Do Until ActiveCell.Value = "BW"
            ActiveCell.Offset(1, 0).Select
        Loop
    ElseIf ws = "Insure Wiser" Then
        Do Until ActiveCell.Value = "IW"
            ActiveCell.Offset(1, 0).Select
        Loop
    ElseIf ws = "Call Wiser" Then
        Do Until ActiveCell.Value = "CW"
            ActiveCell.Offset(1, 0).Select
        Loop
    ElseIf ws = "Quote Wiser" Then
        Do Until ActiveCell.Value = "QW"
            ActiveCell.Offset(1, 0).Select
        Loop
    ElseIf ws = "Be Wiser Business" Then
        Do Until ActiveCell.Value = "BWB"
            ActiveCell.Offset(1, 0).Select
        Loop
    ElseIf ws = "Younger But Wiser" Then
        Do Until ActiveCell.Value = "YBW"
            ActiveCell.Offset(1, 0).Select
        Loop
    End If

    'insert row and paste
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

        'lastrow = Range("A" & Rows.Count).End(xlUp).Row + 1
        'Range("A" & lastrow).Select
        'ActiveSheet.Paste
        ws.Activate
        lastrow = Range("A" & Rows.Count).End(xlUp).Row
        Cells.Select
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range("A2:A19" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.ActiveSheet.Sort
        .SetRange Range("A1:U" & lastrow)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("M1").Select
            Do Until ActiveCell.Value = "Status" Or ActiveCell.Column > 100
            ActiveCell.Offset(0, 1).Select
        Loop
Else
            ActiveCell.Offset(1, 0).Select
            End If

        Loop
there:
            'here
            flastrow = Workbooks("Copy of merge.xlsb").Worksheets("Combined").Range("A" & Rows.Count).End(xlUp).Row

            If blastrow = flastrow Then
                Workbooks("Copy of merge.xlsb").Worksheets("Combined").Activate
                Range("A" & blastrow).Select
                ActiveCell.EntireRow.Delete
                Workbooks(wb).Worksheets(wsName).Activate
            End If

           Next ws

        Workbooks(wb).Close False

      End If
     file = Dir
  Wend

  Call storeFileNames

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

Answer 1

正如已经指出的那样，你真的应该重写它，但作为一个快速修复，添加一个范围变量：

Dim rgCut as Excel.Range

然后代替：

ActiveCell.EntireRow.Cut

使用：

set rgCut = ActiveCell.EntireRow

然后替换它：

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

用这个：

rgCut.Cut Destination:=Selection.Cells(1)

VBA错误1004：范围类的PasteSpecial方法失败

1 个答案: