Not able to go beyond 9

[andytpl]

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

[RichardSchollar]

Hi

Not gone thru in any great detail so may have missed something but try:


On Error Resume Next
Set wks = Worksheets("INF" & Format(i,"000"))
If Err <> 0 Then Exit For
On Error Goto 0

Richard

[andytpl]

Richard,

I tried it out and it works. Thanks