PDA

View Full Version : Merge Only Visible Worksheets



rlivingsd
03-20-2017, 02:09 PM
I am working with Excel 2016. I have a Workbook that contains a Main worksheet (where I am consolidating the data in a "pretty" format), an ERP New worksheet, an ERP Active worksheet, a 'hidden' Sheet1 worksheet (contains outside ODBC links), and a Master Worksheet that is created with my code. I found this code on this site and would like to customize it so it will only copy the visible worksheets. I want the data starting on row 5 to be copied into the Master worksheet from both the ERP New and the ERP Active worksheets. They both have the same headers, but have different numbers of rows. I want all data from A5:T5 until there is a blank row. I do not want the data from Sheet1 to be merged.

Any help would be greatly appreciated!! Thank you!




Sub CopyFromWorksheets() Dim wrk As Workbook
Dim sht As Worksheet
Dim trg As Worksheet
Dim rng As Range
Dim colCount As Integer

Set wrk = ActiveWorkbook




Application.ScreenUpdating = False


Set trg = wrk.Worksheets.Add(After:=wrk.Worksheets(wrk.Worksheets.Count))
trg.Name = "Master"
Set sht = wrk.Worksheets(1)
colCount = sht.Cells(1, 255).End(xlToLeft).Column
With trg.Cells(1, 1).Resize(1, colCount)
.Value = sht.Cells(1, 1).Resize(1, colCount).Value
.Font.Bold = True
End With


For Each sht In wrk.Worksheets
If sht.Index = wrk.Worksheets.Count Then
Exit For
End If
Set rng = sht.Range(sht.Cells(2, 1), sht.Cells(65536, 1).End(xlUp).Resize(, colCount))
trg.Cells(65536, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
Next sht
trg.Columns.AutoFit


Application.ScreenUpdating = True
End Sub

mancubus
03-21-2017, 04:27 AM
welcome to the forum.

if you only want to exclude the hidden sheets, try this.



Sub CopyFromWorksheets()

Dim wrk As Workbook
Dim sht As Worksheet, trg As Worksheet
Dim rng As Range
Dim colCount As Long

Application.ScreenUpdating = False

Set wrk = ActiveWorkbook
Set trg = wrk.Worksheets.Add(After:=wrk.Worksheets(wrk.Worksheets.Count))
trg.Name = "Master"
Set sht = wrk.Worksheets(1)
colCount = sht.Cells(1, Columns.Count).End(xlToLeft).Column

With trg.Cells(1, 1).Resize(1, colCount)
.Value = sht.Cells(1, 1).Resize(1, colCount).Value
.Font.Bold = True
End With

For Each sht In wrk.Worksheets
With sht
If .Index = wrk.Worksheets.Count Then
Exit For
End If
If .Visible = xlSheetVisible Then
Set rng = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp).Resize(, colCount))
trg.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
End If
End With
Next sht

trg.Columns.AutoFit

Application.ScreenUpdating = True

End Sub