将列复制到下一列

Question

我的目标是获得一个宏，复制整个 R 列并将其粘贴到下一个 S 列中。当我再次使用该按钮时，R 列被复制，并且应该粘贴到 T 列中。

Sub CopyPaste()
Application.ScreenUpdating = False
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet


Set copySheet = Worksheets("Sheet1")
Set pasteSheet = Worksheets("Sheet1")

copySheet.Range("R:R").Copy
pasteSheet.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial


Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

但是当我使用宏时，该列会被复制，但不会移动到下一列，也不会粘贴到 R 列中。

Answer 1

无需复制粘贴。

Sub copyRange()

Dim xLAppL As Excel.Application: Set xLAppL = GetObject(, "Excel.Application")
Dim wrkBk As Excel.Workbook: Set wrkBk = xLAppL.ActiveWorkbook
Dim wrksH As Worksheet: Set wrksH = wrkBk.ActiveSheet


Dim sourceArr() As Variant: sourceArr = wrksH.Range("r:r") '.CurrentRegion

    wrksH.Range("T1").Resize(UBound(sourceArr, 1), UBound(sourceArr, 2)).Value2 = sourceArr

End Sub

Answer 2

为了避免空单元格问题，请使用此

Sub CopyPaste()
Application.ScreenUpdating = False
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet


Set copySheet = Worksheets("Sheet1")
Set pasteSheet = Worksheets("Sheet1")

copySheet.Range("R:R").Copy
pasteSheet.Columns(pasteSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column + 1).PasteSpecial


Application.CutCopyMode = False  
Application.ScreenUpdating = True
End Sub

Answer 3

复制整列

Sub CopyEntireColumn()
    
    Application.ScreenUpdating = False
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim copySheet As Worksheet: Set copySheet = wb.Worksheets("Sheet1")
    Dim pasteSheet As Worksheet: Set pasteSheet = wb.Worksheets("Sheet1")
    
    Dim copyRange As Range: Set copyRange = copySheet.Columns("R")
    
    Dim pasteRange As Range:
    
    With pasteSheet.UsedRange
        Set pasteRange = .Resize(, 1).Offset(, .Columns.Count).EntireColumn
    End With
    
    copyRange.Copy pasteRange
    
    Application.ScreenUpdating = True

End Sub