Home |
Search |
Today's Posts |
#1
![]() |
|||
|
|||
![]()
Hello,
I have a macro that will merge my worksheets into one worksheet called "Master". It works fine. Is it possible when I merge my worksheets again to create another worksheet called "Master1"..."Master2"..."Master3"...and so on without overwriting or deleting the previous "Master" worksheet? The workbook is used in Share Mode. Here is the macro that I use: Sub CopyFromWorksheets() Dim wrk As Workbook 'Workbook object - Always good to work with object variables Dim sht As Worksheet 'Object for handling worksheets in loop Dim trg As Worksheet 'Master Worksheet Dim Rng As Range 'Range object Dim colCount As Integer 'Column count in tables in the worksheets 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.Works heets.Count)) 'Rename the new worksheet trg.Name = "Master" 'Get column headers from the first worksheet 'Column count first Set sht = wrk.Worksheets(1) colCount = sht.Cells(1, 255).End(xlToLeft).Column 'Now retrieve headers, no copy&paste needed With trg.Cells(1, 1).Resize(1, colCount) .Value = sht.Cells(1, 1).Resize(1, colCount).Value 'Set font as bold .Font.Bold = True End With 'We can start loop For Each sht In wrk.Worksheets 'If worksheet in loop is the last one, stop execution (it is Master worksheet) If sht.Index = wrk.Worksheets.Count Then Exit For End If 'Data range in worksheet - starts from second row as first rows are the header rows in all worksheets Set Rng = sht.Range(sht.Cells(2, 1), sht.Cells(65536, 1).End(xlUp).Resize(, colCount)) 'Put data into the Master worksheet trg.Cells(65536, 1).End(xlUp).Offset(1).Resize(Rng.Rows.Count, Rng.Columns.Count).Value = Rng.Value Next sht 'Fit the columns in Master worksheet trg.Columns.AutoFit 'Screen updating should be activated Application.ScreenUpdating = True End Sub I appreciate your help. T Thanks Mark |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Merge Worksheets | Excel Discussion (Misc queries) | |||
Trying to merge two excel worksheets | Excel Discussion (Misc queries) | |||
how to merge worksheets in the same workbook | Excel Worksheet Functions | |||
Merge Data From Multiple Worksheets | Excel Worksheet Functions | |||
Multiple Worksheets and Print Merge function | Excel Discussion (Misc queries) |