View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.newusers
Joe[_9_] Joe[_9_] is offline
external usenet poster
 
Posts: 18
Default Help with Worksheet Merging Macro

Dave,
As I pointed out to Otto above I am a self taught excel person and I
simply don't understand the code and boy was I really thrown for a loop with
the function section. Totally lost there. I do appreciate you help but I
cannot determine how to use the code at this point.

Joe

"Dave Peterson" wrote in message
...
You could loop through the list and build an array of names when the
sheets
exist.

Option Explicit
Sub testme02()
Dim mySheetNames As Variant
Dim sCtr As Long 'sheet counter
Dim eCtr As Long 'exist counter
Dim mySheets() As Variant
Dim MWS As Variant 'not just worksheets

mySheetNames = Array("RAY517", "RAY518, RAY519")

ReDim mySheets(LBound(mySheetNames) To UBound(mySheetNames))

eCtr = LBound(mySheetNames) - 1
For sCtr = LBound(mySheetNames) To UBound(mySheetNames)
If SheetExists(mySheetNames(sCtr), ActiveWorkbook) Then
eCtr = eCtr + 1
mySheets(eCtr) = mySheetNames(sCtr)
End If
Next sCtr

If eCtr < LBound(mySheetNames) Then
'no sheets exist!
Else
ReDim Preserve mySheets(LBound(mySheets) To eCtr)
For Each MWS In mySheets
MsgBox MWS
Next MWS

'or I like this way...
For sCtr = LBound(mySheets) To UBound(mySheets)
MsgBox mySheets(sCtr)
Next sCtr
End If

End Sub
Function SheetExists(SheetName As Variant, _
Optional WhichBook As Workbook) As Boolean
'from Chip Pearson
Dim WB As Workbook
Set WB = IIf(WhichBook Is Nothing, ThisWorkbook, WhichBook)
On Error Resume Next
SheetExists = CBool(Len(WB.Sheets(SheetName).Name) 0)
On Error GoTo 0
End Function

Joe wrote:

I found the following post for Merging Excel worksheets and after I added
the Array statement it works great for my application except for one
minor
problem. I have to crate this report on a monthly basis and all three of
the
worksheets do not exist every month. I no there has to be a way to attach
a
statement that checks to see that each tab exists before proceeding or
existing the macro becasue of an error. Could someone please help?

Sub MergeSheets()

' Merges data from all the selected worksheets onto the end of the
' active worksheet.

Const NHR = 1 'Number of header rows to not copy from each MWS
Sheets(Array("RAY517", "RAY518, RAY519")).Select
Sheets("RAY517").Activate

Dim MWS As Worksheet 'Worksheet to be merged
Dim AWS As Worksheet 'Worksheet to which the data are transferred
Dim FAR As Long 'First available row on AWS
Dim LR As Long 'Last row on the MWS sheets

Set AWS = ActiveSheet

For Each MWS In ActiveWindow.SelectedSheets
If Not MWS Is AWS Then
FAR = AWS.UsedRange.Cells(AWS.UsedRange.Cells.Count).Row + 1
LR = MWS.UsedRange.Cells(MWS.UsedRange.Cells.Count).Row
MWS.Range(MWS.Rows(NHR + 1), MWS.Rows(LR)).Copy AWS.Rows(FAR)
End If
Next MWS

End If

Joe


--

Dave Peterson