批量复制粘贴1列

Question

我想以约500的批量复制粘贴1个大列（200.000行），中间延迟1秒，然后用宏将它们粘贴到表Y上。听起来很简单，但我一直在查看一些主题，无法让它发挥作用。

使用Excel 2013。

修改

Sub batchpaste()

Dim a As Worksheet
Dim b As Worksheet


Set a = Sheets("Sheet1") 'replace with your source sheet
Set b = Sheets("Sheet2") 'replace with your destination sheet

neverRan = False
counter = 10
startRow = 1
For c = 1 To a.Range("iv1").End(xlToLeft).Column 'find last column
beginning:
    lastrow = a.Cells(65536, c).End(xlUp).Row 'find last row
    If lastrow <= counter Then
        b.Range(b.Cells(startRow, c), b.Cells(lastrow, c)).Value = a.Range(a.Cells(startRow, c), a.Cells(lastrow, c)).Value
        counter = 10
        startRow = 1
        neverRan = False
        Application.Wait (Now + #12:00:05 AM#) 'enter seconds of delay here (set at 1 seconds right now)
    ElseIf neverRan = False Then
        b.Range(b.Cells(startRow, c), b.Cells(counter, c)).Value = a.Range(a.Cells(startRow, c), a.Cells(counter, c)).Value
        startRow = startRow + 10
        counter = counter + 10
        neverRan = True
        GoTo beginning
        Application.Wait (Now + #12:00:05 AM#) 'enter seconds of delay here (set at 1 seconds right now)
    Else
        b.Range(b.Cells(startRow, c), b.Cells(counter, c)).Value = a.Range(a.Cells(startRow, c), a.Cells(counter, c)).Value
        startRow = startRow + 10
        counter = counter + 10
        GoTo beginning
        Application.Wait (Now + #12:00:05 AM#) 'enter seconds of delay here (set at 1 seconds right now)
    End If
Next c

End Sub

Answer 1

Sub asdf()

    Dim a As Worksheet
    Dim b As Worksheet

    Set a = Sheets("Sheet2") 'replace with your source sheet
    Set b = Sheets("Sheet3") 'replace with your destination sheet

    For c = 1 To a.Range("iv1").End(xlToLeft).Column 'find last column
        lastrow = a.Cells(65536, c).End(xlUp).Row 'find last row
        b.Range(b.Cells(1, c), b.Cells(lastrow, c)).Value = a.Range(a.Cells(1, c), a.Cells(lastrow, c)).Value
    Next c

End Sub

修改

Sub asdf()

    Dim a As Worksheet
    Dim b As Worksheet

    Set a = Sheets("Sheet1") 'replace with your source sheet
    Set b = Sheets("Sheet2") 'replace with your destination sheet

    neverRan = False
    counter = 1000
    startRow = 1
    For c = 1 To a.Range("iv1").End(xlToLeft).Column 'find last column
beginning:
        lastrow = a.Cells(65536, c).End(xlUp).Row 'find last row
        If lastrow <= counter Then
            b.Range(b.Cells(startRow, c), b.Cells(lastrow, c)).Value = a.Range(a.Cells(startRow, c), a.Cells(lastrow, c)).Value
            counter = 1000
            startRow = 1
            neverRan = False
            Application.wait (Now + #12:00:01 AM#) 'enter seconds of delay here (set at 1 seconds right now)
        ElseIf neverRan = False Then
            b.Range(b.Cells(startRow, c), b.Cells(counter, c)).Value = a.Range(a.Cells(startRow, c), a.Cells(counter, c)).Value
            startRow = startRow + 1000
            counter = counter + 1000
            neverRan = True
            GoTo beginning
            Application.wait (Now + #12:00:01 AM#) 'enter seconds of delay here (set at 1 seconds right now)
        Else
            b.Range(b.Cells(startRow, c), b.Cells(counter, c)).Value = a.Range(a.Cells(startRow, c), a.Cells(counter, c)).Value
            startRow = startRow + 1000
            counter = counter + 1000
            GoTo beginning
            Application.wait (Now + #12:00:01 AM#) 'enter seconds of delay here (set at 1 seconds right now)
        End If
    Next c

End Sub