merge worksheets

  • Thread starter Thread starter dhermus
  • Start date Start date
D

dhermus

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 Before:=Sheets(2)

End Sub
 
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/showthread.php?t=152401

Microsoft Office Help
Click to expand...

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


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/showthread.php?t=152401

Microsoft Office Help
Click to expand...

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