Copy all sheets of a Workbook to a 'Master' sheet horizontally

copyallh.vba

Sub CopyAllH()
    
    Dim wrk  As Workbook    'Workbook object
    Dim sht  As Worksheet   'Object for handling worksheets in loop
    Dim trg  As Worksheet   'Master Worksheet as a target
    Dim col  As Integer     'Column count
    Dim i    As Integer     'Some index
    Dim rng  As Range       'Range object
    Dim rng1 As Range       'Range object
    Dim rng2 As Range       'Range object
 
    Set wrk = ActiveWorkbook    'Working in active workbook
     
    For Each sht In wrk.Worksheets
        If sht.name = "Master" Then
            sht.Delete
        End If
    Next sht
     
    'We don't want screen updating
    'Application.ScreenUpdating = False
     
    'Add new worksheet as the last worksheet
    Set trg = wrk.Worksheets.Add(After:=wrk.Worksheets(wrk.Worksheets.Count))
    
    'Rename the new worksheet
    trg.name = "Master"
      
    'We can start loop
    For i = 1 To wrk.Worksheets.Count - 1

        'Select sheet
        Set sht = wrk.Worksheets(i)
        
        'Data range in worksheet
        Set rng1 = sht.Cells.Find("*", [A1], , , xlByRows, xlPrevious)
        Set rng2 = sht.Cells.Find("*", [A1], , , xlByColumns, xlPrevious)
        Set rng = sht.Range(sht.Cells(1, 1), sht.Cells(rng1.Row, rng2.Column))
        
        'Put data into the Master worksheet
        col = trg.Cells(2, Columns.Count).End(xlToLeft).Column
        rng.Copy
        With trg.Cells(1, col)
            .PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        End With
 
    Next i
    
    'Fit the columns in Master worksheet
    trg.Columns.AutoFit
     
    'Screen updating should be activated
    Application.ScreenUpdating = True
 
End Sub