Last active
August 29, 2015 14:13
-
-
Save vmassuchetto/a2ca5424b877a7214d09 to your computer and use it in GitHub Desktop.
Copy all sheets of a Workbook to a 'Master' sheet horizontally
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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 |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment