'Run two variable loop to increment the column number for diff. sheets [closed]

I want to run this in loop by taking two variables for example i and j. Suppose i for sheet 1 and 2 and j for Sheet 3 until I dont reach the end column of sheet 1 or 2.

Sub CopyColumn()
'
' CopyColumn Macro
'

'
    Sheets("Sheet1").Select
    Columns("A:A").Select
    Selection.Copy
    Sheets("Sheet3").Select
    Columns("A:A").Select
    ActiveSheet.Paste
    Sheets("Sheet2").Select
    Columns("A:A").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet3").Select
    Columns("B:B").Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    Columns("B:B").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet3").Select
    Columns("C:C").Select
    ActiveSheet.Paste
    Sheets("Sheet2").Select
    Columns("B:B").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet3").Select
    Columns("D:D").Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    Columns("C:C").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet3").Select
    Columns("E:E").Select
    ActiveSheet.Paste
    Sheets("Sheet2").Select
    Columns("C:C").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet3").Select
    Columns("F:F").Select
    ActiveSheet.Paste
End Sub

I want to run this in loop by taking two variables for example i and j. Suppose i for sheet 1 and 2 and j for Sheet 3 until I dont reach the end column of sheet 1 or 2



Solution 1:[1]

Try two loops

    Sub CopyColumn()
    Dim sh1 As Worksheet, sh2 As Worksheet
    Dim dest As Worksheet, i, j
    Dim L1 As Long, L2 As Long
    Set sh1 = Sheets("Sheet1")
    Set sh2 = Sheets("Sheet2")
    Set dest = Sheets("Sheet3")

    With sh1
        L1 = .Cells.Find(What:="*", After:=.Range("A1"), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    End With
    With sh2
        L2 = .Cells.Find(What:="*", After:=.Range("A1"), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    End With
    With dest
        x = 0
        For i = 1 To L1
            sh1.Columns(i).Copy .Cells(1, 1 + x)
            x = x + 2
        Next i
        x = 0
        For j = 1 To L2
            sh2.Columns(j).Copy .Cells(1, 2 + x)
            x = x + 2
        Next j
    End With
   
End Sub

Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution Source
Solution 1 Davesexcel