Copy paste to column on two sheets

user_15399082 0
Viewed 56

I have two sheets in same workbook. I want to copy data from column A to next empty column in both sheets.

I get an error in paste line of the code.

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
vba excel
2 Answers

for a clearer code the variable ws1 corresponds to Sheet1 and analogously ws2 corresponds to 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

Update after your question in the comment:

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
user_153689120

Copy Column

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
user_98140690
Related