Home |
Search |
Today's Posts |
#1
![]() |
|||
|
|||
![]()
Hello,
I have a couple of worksheets that I need to merge into one worksheet which I can do with no problem but how can I keep the existing format from each worksheet in the new merged worksheet? Some of the formats that I have are highlighted cells. Here is the macro that I am using. Thanks in advance. Mark Sub CopyFromWorksheets() Dim wrk As Workbook 'Workbook object - Always good to work withobjectvariables 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 Sheets(wrk.Worksheets.Count).Select If ActiveSheet.Name Like "Master*" Then MyName = Mid(ActiveSheet.Name, (InStr(1, ActiveSheet.Name, "r") + 1)) NewSheet = "Master" & (MyName + 1) Else NewSheet = "Master" & (MyName + 1) End If '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 = NewSheet '"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 isMasterworksheet) If sht.Index = wrk.Worksheets.Count Then Exit For End If If sht.Name Like "Master*" 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Changing a Link Mid-way Across Worksheets | Excel Worksheet Functions | |||
can't format cell - have tried unlocking and unprotecting | Excel Discussion (Misc queries) | |||
why does currency format change to number format? | Excel Discussion (Misc queries) | |||
Keep custom format in new worksheet | Excel Discussion (Misc queries) | |||
How to format a date to a different format | Excel Discussion (Misc queries) |