andytpl
08-13-2007, 12:04 AM
I have this piece of codes which is suppose to summarise in the Summary worksheet all the selected data from worksheet tab with names as INF001, INF002 and so on. But, strangely the data pull into the Summary sheet stops at INF009. How could I change the codes so that this problem can be overcome. Below are the codes.
Appreciate any help to solve this problem.
Sub Populate()
Dim i As Long
Dim wks As Worksheet
Dim wksSummary As Worksheet
If MsgBox("This will clear the data present in the Summary sheet." & vbCrLf & _
"Press 'Yes' to proceed.", vbCritical + vbDefaultButton2 + vbYesNo, "Generate Summary Sheet") = vbYes Then
Set shtActive = Application.ActiveSheet
Application.StatusBar = "Finding Rows to Remove"
'Find the last row
iRow = 8 'Starting row to check
iBlanks = 0
Do While iBlanks < 5
'after 5 blanks rows then stop
If shtActive.Cells(iRow, 1) = "" Then
iBlanks = iBlanks + 1
Else
iBlanks = 0
End If
iRow = iRow + 1
Loop
iRowRemove = iRow
Application.StatusBar = "Removing Rows"
For iRow = iRowRemove To 8 Step -1
'Remove rows from the back
shtActive.Rows(iRow).Select
Selection.Delete Shift:=xlUp
Next
End If
Set wksSummary = Worksheets("Summary")
For i = 1 To Worksheets.Count
On Error Resume Next
Set wks = Worksheets("INF00" & i)
If Err <> 0 Then Exit For
On Error GoTo 0
With wks
wksSummary.Range("A" & i + 7).Value2 = .Range("B3").Value2
wksSummary.Range("B" & i + 7).Value2 = .Range("B10").Value2
wksSummary.Range("C" & i + 7).Value2 = .Range("B12").Value2
wksSummary.Range("D" & i + 7).Value2 = .Range("G3").Value2
wksSummary.Range("E" & i + 7).Value2 = .Range("K4").Value2
wksSummary.Range("F" & i + 7).Value2 = .Range("K5").Value2
wksSummary.Range("G" & i + 7).Value2 = .Range("k6").Value2
wksSummary.Range("H" & i + 7).Value2 = .Range("k7").Value2
wksSummary.Range("I" & i + 7).Value2 = .Range("I12").Value2
wksSummary.Range("J" & i + 7).Value2 = .Range("B14").Value2
wksSummary.Range("K" & i + 7).Value2 = .Range("G6").Value2
wksSummary.Range("L" & i + 7).Value2 = .Range("B4").Value2
wksSummary.Range("M" & i + 7).Value2 = .Range("C36").Value2
wksSummary.Range("N" & i + 7).Value2 = .Range("C27").Value2
wksSummary.Range("O" & i + 7).Value2 = .Range("K3").Value2
wksSummary.Range("P" & i + 7).Value2 = .Range("B1").Value2
wksSummary.Range("Q" & i + 7).Value2 = .Range("I14").Value2
wksSummary.Range("R" & i + 7).Value2 = .Range("M1").Value2
End With
Next i
Set wks = Nothing
Set wksSummary = Nothing
End Sub
Appreciate any help to solve this problem.
Sub Populate()
Dim i As Long
Dim wks As Worksheet
Dim wksSummary As Worksheet
If MsgBox("This will clear the data present in the Summary sheet." & vbCrLf & _
"Press 'Yes' to proceed.", vbCritical + vbDefaultButton2 + vbYesNo, "Generate Summary Sheet") = vbYes Then
Set shtActive = Application.ActiveSheet
Application.StatusBar = "Finding Rows to Remove"
'Find the last row
iRow = 8 'Starting row to check
iBlanks = 0
Do While iBlanks < 5
'after 5 blanks rows then stop
If shtActive.Cells(iRow, 1) = "" Then
iBlanks = iBlanks + 1
Else
iBlanks = 0
End If
iRow = iRow + 1
Loop
iRowRemove = iRow
Application.StatusBar = "Removing Rows"
For iRow = iRowRemove To 8 Step -1
'Remove rows from the back
shtActive.Rows(iRow).Select
Selection.Delete Shift:=xlUp
Next
End If
Set wksSummary = Worksheets("Summary")
For i = 1 To Worksheets.Count
On Error Resume Next
Set wks = Worksheets("INF00" & i)
If Err <> 0 Then Exit For
On Error GoTo 0
With wks
wksSummary.Range("A" & i + 7).Value2 = .Range("B3").Value2
wksSummary.Range("B" & i + 7).Value2 = .Range("B10").Value2
wksSummary.Range("C" & i + 7).Value2 = .Range("B12").Value2
wksSummary.Range("D" & i + 7).Value2 = .Range("G3").Value2
wksSummary.Range("E" & i + 7).Value2 = .Range("K4").Value2
wksSummary.Range("F" & i + 7).Value2 = .Range("K5").Value2
wksSummary.Range("G" & i + 7).Value2 = .Range("k6").Value2
wksSummary.Range("H" & i + 7).Value2 = .Range("k7").Value2
wksSummary.Range("I" & i + 7).Value2 = .Range("I12").Value2
wksSummary.Range("J" & i + 7).Value2 = .Range("B14").Value2
wksSummary.Range("K" & i + 7).Value2 = .Range("G6").Value2
wksSummary.Range("L" & i + 7).Value2 = .Range("B4").Value2
wksSummary.Range("M" & i + 7).Value2 = .Range("C36").Value2
wksSummary.Range("N" & i + 7).Value2 = .Range("C27").Value2
wksSummary.Range("O" & i + 7).Value2 = .Range("K3").Value2
wksSummary.Range("P" & i + 7).Value2 = .Range("B1").Value2
wksSummary.Range("Q" & i + 7).Value2 = .Range("I14").Value2
wksSummary.Range("R" & i + 7).Value2 = .Range("M1").Value2
End With
Next i
Set wks = Nothing
Set wksSummary = Nothing
End Sub