LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 16
Default 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
 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
How do you merge worksheets Kate Excel Worksheet Functions 1 January 10th 08 06:20 PM
How can I merge two worksheets together foxefire21 Excel Worksheet Functions 2 October 27th 07 01:05 AM
How to merge worksheets on a key - merge horizontally, that is [email protected] Excel Programming 4 November 4th 06 12:59 AM
Merge Worksheets Douglas McDonald Excel Discussion (Misc queries) 3 October 17th 05 10:20 PM
Merge Worksheets Mark Jackson Excel Worksheet Functions 0 June 8th 05 10:42 PM


All times are GMT +1. The time now is 04:39 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"