![]() |
merge worksheets
I am using a variation of the code from Ron DeBruin to merge multiple
worksheets into one worksheet. When doing so, I am getting cell values, but I would like to get all formulas and formatting from the source worksheets. Can anyone help. Option Explicit Sub MergeWorksheets() Dim wrk As Workbook 'Workbook object - Always good to work with object variables Dim sht As Worksheet 'Object for handling worksheets in loop Dim mst 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 = "All Accounts-Details" Then MsgBox "There is a worksheet called 'All Accounts- Details'." & vbCrLf & _ "Please remove or rename this worksheet since this is" & _ "the name of the result worksheet of this process.", vbOKOnly + vbExclamation, "Error" Exit Sub End If Next sht 'Deactivate Screen Updating Application.ScreenUpdating = False 'Add new worksheet as the first worksheet Set mst = wrk.Worksheets.Add(after:=wrk.Worksheets(14)) 'Rename the new worksheet mst.Name = "All Accounts-Details" 'Get column headers from the second worksheet 'Column count first Set sht = wrk.Worksheets(2) colCount = sht.Cells(1, 255).End(xlToLeft).Column 'Retrieve headers, no copy & paste needed With mst.Cells(1, 1).Resize(1, colCount) .Value = sht.Cells(1, 1).Resize(1, colCount).Value 'Set font as bold .Font.Bold = True End With 'Start loop For Each sht In wrk.Worksheets 'If worksheet in loop is the last one, stop execution If sht.Index = wrk.Worksheets.Count Then Exit For End If If sht.Name < Sheet9.Name Then If sht.Visible = xlSheetVisible Then ' copy the data Set rng = sht.Range(sht.Cells(2, 1), sht.Cells(65536, 1).End (xlUp).Offset(-1).Resize(, colCount)) mst.Cells(65536, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value End If End If Next 'Fit the columns in Master worksheet mst.Columns.AutoFit ' Columns("A:A").Select Selection.AutoFilter Selection.AutoFilter Field:=1, Criteria1:="<0" 'Activate Screen Updating Application.ScreenUpdating = True wrk.Worksheets(3).Select Range("A1:BJ1").Select Selection.Copy ActiveWindow.ScrollWorkbookTabs Position:=xlLast Sheets("All Accounts-Details").Select Range("A1:BJ1").Select Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Sheets("All Accounts-Details").Select Columns("F:F").Select Application.CutCopyMode = False Selection.NumberFormat = "@" Cells(1, 1).Select Sheets("All Accounts-Details").Select Sheets("All Accounts-Details").Move Befo=Sheets(2) End Sub |
merge worksheets
there are 3 places you are pasting code 1) from With mst.Cells(1, 1).Resize(1, colCount) .Value = sht.Cells(1, 1).Resize(1, colCount).Value 'Set font as bold .Font.Bold = True End With to sht.Cells(1, 1).Resize(1, colCount).copy destination:=mst.Cells(1, 1).Resize(1, colCount) 2) from Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False to Selection.Paste 3) from Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False to Selection.Paste -- joel ------------------------------------------------------------------------ joel's Profile: http://www.thecodecage.com/forumz/member.php?userid=229 View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=152401 Microsoft Office Help |
merge worksheets
On Nov 9, 12:22*pm, joel wrote:
there are 3 places you are pasting code 1) from With mst.Cells(1, 1).Resize(1, colCount) Value = sht.Cells(1, 1).Resize(1, colCount).Value 'Set font as bold Font.Bold = True End With to sht.Cells(1, 1).Resize(1, colCount).copy destination:=mst.Cells(1, 1).Resize(1, colCount) 2) from Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False to Selection.Paste 3) from Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False to Selection.Paste -- joel ------------------------------------------------------------------------ joel's Profile:http://www.thecodecage.com/forumz/member.php?userid=229 View this thread:http://www.thecodecage.com/forumz/sh...d.php?t=152401 Microsoft Office Help Joel, Thanks for the help. Unfortunately, it doesn't like the selection.paste command. I am getting the error message "object doesn't support this property or method." Dave |
merge worksheets
Try this change from last posting from sht.Cells(1, 1).Resize(1, colCount).copy destination:=mst.Cells(1, 1).Resize(1, colCount) to sht.Cells(1, 1).Resize(1, colCount).copy destination:=mst.Cells(1, 1) -- joel ------------------------------------------------------------------------ joel's Profile: http://www.thecodecage.com/forumz/member.php?userid=229 View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=152401 Microsoft Office Help |
merge worksheets
On my webpage
http://www.rondebruin.nl/copy2.htm You can see examples below the macro CopyRng.Copy DestSh.Cells(Last + 1, "A") -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "dhermus" wrote in message ... On Nov 9, 12:22 pm, joel wrote: there are 3 places you are pasting code 1) from With mst.Cells(1, 1).Resize(1, colCount) Value = sht.Cells(1, 1).Resize(1, colCount).Value 'Set font as bold Font.Bold = True End With to sht.Cells(1, 1).Resize(1, colCount).copy destination:=mst.Cells(1, 1).Resize(1, colCount) 2) from Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False to Selection.Paste 3) from Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False to Selection.Paste -- joel ------------------------------------------------------------------------ joel's Profile:http://www.thecodecage.com/forumz/member.php?userid=229 View this thread:http://www.thecodecage.com/forumz/sh...d.php?t=152401 Microsoft Office Help Joel, Thanks for the help. Unfortunately, it doesn't like the selection.paste command. I am getting the error message "object doesn't support this property or method." Dave |
merge worksheets
On Nov 9, 2:21*pm, joel wrote:
Try this change from last posting from sht.Cells(1, 1).Resize(1, colCount).copy destination:=mst.Cells(1, 1).Resize(1, colCount) to sht.Cells(1, 1).Resize(1, colCount).copy destination:=mst.Cells(1, 1) -- joel ------------------------------------------------------------------------ joel's Profile:http://www.thecodecage.com/forumz/member.php?userid=229 View this thread:http://www.thecodecage.com/forumz/sh...d.php?t=152401 Microsoft Office Help Same results Dave |
All times are GMT +1. The time now is 10:00 AM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com