Option Explicit
Sub PrintTopRangeWS()
Dim ws As Worksheet, tmp As Worksheet
Dim LR As Long, LCol As Long
'--> Create temporary sheet to sort data
Application.DisplayAlerts = False
On Error Resume Next
ThisWorkbook.Sheets("Temp").Delete
ThisWorkbook.Sheets.Add.Name = "Temp"
Application.DisplayAlerts = True
Set tmp = Sheets("Temp")
'--> Define top range and copy to temp sheet
For Each ws In ThisWorkbook.Worksheets
With ws
If Not ws.Name = "Temp" Then
LR = .Range("A1:A" & Rows.Count).End(xlDown).Row
LCol = .Cells(, Columns.Count).End(xlToLeft).Column
.Range("A1" & ":" & Split(Cells(1, LCol).Address, "$")(1) & LR).Copy
tmp.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If
End With
Next
'Print consolidated data
tmp.PrintOut
'Delete temporary sheet
Application.DisplayAlerts = False
tmp.Delete
Application.DisplayAlerts = True
End Sub
No comments:
Post a Comment