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
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