在Excel VBA中将数据从一张纸移动到另一张纸而无需复制粘贴

Question

I have a macro running in the background which takes around 30 minutes to complete.

It moves data from one sheet to another using code like this:

            .AutoFilter Field:=19, Criteria1:=Array("Rejected", "Withdrawn"), Operator:=7
            If xlapp.WorksheetFunction.Subtotal(3, .Range("A2:A500000")) <> 0 Then
                Set wsNew = xlapp.Sheets.Add(After:=xlapp.Sheets(xlapp.Sheets.Count))
                wsNew.Name = "Rejected & Withdrawn"
                wsNew.Tab.Color = RGB(255, 125, 125)
                .SpecialCells(12).Copy Destination:=wsNew.Range("A1")
                wsNew.Cells.EntireColumn.AutoFit
            End If

The clipboard is constantly in use, meaning I can't reliably use the clipbaord when the macro is running.

Is there a way to move (or copy) a row of data without using the clipboard?

Ideally I'd like to avoid looping through the row's columns as this may increase the amount of time it takes to run the macro.

Answer 1

One way is by using Advanced Filter (modify "Sheet1" so it matches your worksheet name):

Set wsNew = xlApp.Sheets.Add(After:=xlApp.Sheets(xlApp.Sheets.Count))
wsNew.Name = "Rejected & Withdrawn"
wsNew.Tab.Color = RGB(255, 125, 125)
With Worksheets("Sheet1")
    wsNew.Range("A1").Value = .Cells(1, 19).Value
    wsNew.Range("A2").Value = "Withdrawn"
    wsNew.Range("A3").Value = "Rejected"
    .UsedRange.AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=wsNew.Range("A1:A3"), CopyToRange:=wsNew.Range("C1"), Unique:=False
End With
wsNew.Range("A:B").EntireColumn.Delete
wsNew.UsedRange.Columns.AutoFit