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

Hi Rashid

That should be fairly straightforward as the code already excludes the
master sheet, so you just need to add code to exclude the other two:

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 Or wks.Name = "Customers" Or
wks.Name = "Main" 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


Hope this helps!

Richard



On 7 Feb, 07:16, wrote:
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

On Feb 7, 2:03 pm, "RichardSchollar"
wrote:
HiRashid

That should be fairly straightforward as the code already excludes the
master sheet, so you just need to add code to exclude the other two:

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 Or wks.Name = "Customers" Or
wks.Name = "Main" 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

Hope this helps!

Richard

On 7 Feb, 07:16, wrote:



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

RashidKhan- Hide quoted text -

- Show quoted text -

Thanks Richard. Works great