Help with Code to Copy to New Worksheet

P

prkhan56

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
 
R

RichardSchollar

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



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
Click to expand...
 
P

prkhan56

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

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.
Click to expand...
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.
Click to expand...
Can any body help me out
Click to expand...
Following is the macro:
Click to expand...
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")
Click to expand...
Set newWks = Worksheets.Add(after:=Worksheets(Worksheets.Count))
Click to expand...
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
Click to expand...
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
Click to expand...

RashidKhan- Hide quoted text -
Click to expand...

- Show quoted text -
Click to expand...

Thanks Richard. Works great
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Coding Help 5
VBA Coding Help for Beginner 0
Print Selected Items in Excel Order Form 10
Locate and Move Specific Cells 2
Inaccurate count with code 6
Help needed! Extracting Heading 3 and Contents from a Word Doc to Excel 0
delete duplicates 0
deleting rows based on criteria 8

Top