复制粘贴到两张纸上的列

Question

我在同一个工作簿中有两张工作表。我想将数据从 A 列复制到两个工作表中的下一个空列。

我在粘贴代码行时遇到错误。

Sub Macro1()
'
' Macro1 Macro
'

'
    Sheets("Sheet1").Select

    Range("A1:A6").Select
    Selection.Copy
    Range("B1").Select
    Selection.PasteSpecial Paste:=xlPasteValues.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1)
    Range("A8").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = ""
    Sheets("Sheet2").Select
    Range("A1:A6").Select
    Selection.Copy
    Range("B1").Select
    Selection.PasteSpecial Paste:=xlPasteValues.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1)
    Range("A9").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = ""
    Range("A10").Select
End Sub

Answer 1

复制列

Option Explicit

Sub copyColumn()
    
    Dim wb As Workbook: Set wb = ThisWorkbook  ' workbook containing this code
    
    Dim sws As Worksheet: Set sws = wb.Worksheets("Sheet1")
    Dim srg As Range: Set srg = sws.UsedRange.Columns(1)
    Dim drg As Range
    
    Set drg = sws.Cells(1, sws.Columns.Count).End(xlToLeft) _
        .Offset(, 1).Resize(srg.Rows.Count)
    drg.Value = srg.Value
    
    Dim dws As Worksheet: Set dws = wb.Worksheets("Sheet2")
    
    Set drg = dws.Cells(1, dws.Columns.Count).End(xlToLeft) _
        .Offset(, 1).Resize(srg.Rows.Count)
    drg.Value = srg.Value
    
End Sub

Answer 2

为了更清晰的代码，变量 ws1 对应于 Sheet1，类似地 ws2 对应于 Sheet2

Sub RangeCopy()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")

EmptyCol_Sheet1 = ws1.Cells(1, Columns.Count).End(xlToLeft).Column + 1
EmptyCol_Sheet2 = ws2.Cells(1, Columns.Count).End(xlToLeft).Column + 1

ws1.Range(Cells(1, EmptyCol_Sheet1).Address, Cells(6, EmptyCol_Sheet1).Address).Value = ws1.Range("A1:A6").Value
ws2.Range(Cells(1, EmptyCol_Sheet2).Address, Cells(6, EmptyCol_Sheet2).Address).Value = ws2.Range("A1:A6").Value

End Sub

在评论中您的问题后更新：

Sub RangeCopy()

Dim ArrLen As Variant
Dim SheetsArray As Variant
Dim SheetsArrayLength As Integer

SheetsArray = Array("Sheet1", "Sheet2", "Sheet3") 'Add more SheetsName
SheetsArrayLength = UBound(SheetsArray) - LBound(SheetsArray) 'it count items in array for loop

For i = 0 To SheetsArrayLength
    EmptyCol_Sheet = Worksheets(SheetsArray(i)).Cells(1, Columns.Count).End(xlToLeft).Column + 1
    Worksheets(SheetsArray(i)).Range(Cells(1, EmptyCol_Sheet).Address, _
    Cells(6, EmptyCol_Sheet).Address).Value = Worksheets(SheetsArray(i)).Range("A1:A6").Value
Next i

End Sub