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

  • Thread starter Thread starter Rashid Khan
  • Start date Start date
R

Rashid Khan

Hello All,
Following is the macro posted by Mr. Dave Peterson. It works fineOption 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
 
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
 
Hello Tom,
It works like a charm. U r a great help... as always.
Rashid

Tom Ogilvy said:
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 said:
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
Click to expand...
Click to expand...
 
Back
Top