Help with Code to Copy to New Worksheet
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
|