复制粘贴到两张纸上的列中

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