Help with Mr. Dave Peterson's Code for Consolidating Many Sheets to One
 

Hello All,
Following is the macro posted by Mr. Dave Peterson. It works fine

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 oRow As Long
'billed, balance, due
myAddresses = Array("a55", "a56", "a57")

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

With newWks
.Name = "Cons " & Format(Now, "yyyymmdd_hhmmss")
.Range("a1").Resize(1, 4).Value _
= Array("PartyName", "TotalBilled", "TotalBalance",
"TotalDue")
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

End Sub
<<<
The macro makes a Consolidated Worksheet (Cons) of all the worksheets. I
need to have the following changes to take place in the consolidated
worksheet
1) Set the ColumnWidth to Autofit
2) Have the Sum (Total) at the bottom for each Column (starting from B
onwards).

Any suggestions please
TIA
Rashid

Help with Mr. Dave Peterson's Code for Consolidating Many Sheets to One
 

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("a55", "a56", "a57")

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

With newWks
.Name = "Cons " & Format(Now, "yyyymmdd_hhmmss")
.Range("a1").Resize(1, 4).Value _
= Array("PartyName", "TotalBilled", _
"TotalBalance", "TotalDue")
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

--
Regards,
Tom Ogilvy

"Rashid Khan" wrote in message
...
Hello All,
Following is the macro posted by Mr. Dave Peterson. It works fine

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 oRow As Long
'billed, balance, due
myAddresses = Array("a55", "a56", "a57")

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

With newWks
.Name = "Cons " & Format(Now, "yyyymmdd_hhmmss")
.Range("a1").Resize(1, 4).Value _
= Array("PartyName", "TotalBilled", "TotalBalance",
"TotalDue")
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

End Sub
<<<
The macro makes a Consolidated Worksheet (Cons) of all the worksheets. I
need to have the following changes to take place in the consolidated
worksheet
1) Set the ColumnWidth to Autofit
2) Have the Sum (Total) at the bottom for each Column (starting from B
onwards).

Any suggestions please
TIA
Rashid

Help with Mr. Dave Peterson's Code for Consolidating Many Sheets to One
 

Hello Tom,
It works like a charm. U r a great help... as always.
Rashid

"Tom Ogilvy" wrote in message
...
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("a55", "a56", "a57")

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

With newWks
.Name = "Cons " & Format(Now, "yyyymmdd_hhmmss")
.Range("a1").Resize(1, 4).Value _
= Array("PartyName", "TotalBilled", _
"TotalBalance", "TotalDue")
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

--
Regards,
Tom Ogilvy

"Rashid Khan" wrote in message
...
Hello All,
Following is the macro posted by Mr. Dave Peterson. It works fine

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 oRow As Long
'billed, balance, due
myAddresses = Array("a55", "a56", "a57")

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

With newWks
.Name = "Cons " & Format(Now, "yyyymmdd_hhmmss")
.Range("a1").Resize(1, 4).Value _
= Array("PartyName", "TotalBilled", "TotalBalance",
"TotalDue")
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

End Sub
<<<
The macro makes a Consolidated Worksheet (Cons) of all the worksheets.
I
need to have the following changes to take place in the consolidated
worksheet
1) Set the ColumnWidth to Autofit
2) Have the Sum (Total) at the bottom for each Column (starting from B
onwards).

Any suggestions please
TIA
Rashid