View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
[email protected] prkhan56@gmail.com is offline
external usenet poster
 
Posts: 39
Default Help with Code to Copy to New Worksheet

Hello All,
I am using Office 2003/Window XP and have the following problem
I have this macro (courtesy this fablous newsgroup)
This macro creates a Master Worksheet for all the Sheets present in
the Workbook
I need this macro to exclude two worksheets by the name Main and
Customers when it is run.

I mean two Sheets by the name Main and Customers should not be
included...rest all should be included in the Master Worksheet when
this macro is run.

Can any body help me out

Following is the macro:


Option Explicit
Option Base 0
Sub testme2()
Dim newWks As Worksheet
Dim wks As Worksheet
Dim DestCell As Range
Dim RngToCopy As Range
Dim iCtr As Long
Dim myAddresses As Variant
Dim rng As Range
Dim oRow As Long
'billed, balance, due
myAddresses = Array("e3", "f3", "g3")

Set newWks = Worksheets.Add(after:=Worksheets(Worksheets.Count) )

With newWks
.Name = "Master " & Format(Now, "dd-mm-yyyy_hh-mm")
.Range("a1").Resize(1, 4).Value = Array("Party", "Total Due",
"Total Paid", "Balance")
oRow = 1
End With

For Each wks In ActiveWorkbook.Worksheets
If wks.Name = newWks.Name Then
'do nothing
Else
oRow = oRow + 1
With wks
newWks.Cells(oRow, "A").Value = .Name
For iCtr = LBound(myAddresses) To UBound(myAddresses)
newWks.Cells(oRow, "A").Offset(0, 1 + iCtr).Value
= .Range(myAddresses(iCtr)).Value
Next iCtr
End With
End If
Next wks
For iCtr = 2 To UBound(myAddresses) + 2
Set rng = newWks.Cells(Rows.Count, iCtr).End(xlUp)(2)
rng.FormulaR1C1 = "=Sum(R2C:R[-1]C)"
Next
newWks.Columns.AutoFit
End Sub

Thanks

Rashid Khan