PDA

View Full Version : Solved: Macro won't loop to second worksheet



hunsnowboard
01-23-2009, 03:35 PM
Hi there Everyone! I have this code which works great for the first sheet. And here is my problem... only works for the first sheet, it won't go to the second sheet when arrives to the last row of the first sheet. The worksheet looping code I have copied from this site. Can someone help me and tell me why the macro will not work on all sheets but the first?

Here is the code:


Sub Proba()
Dim i As Long
Dim ws As Worksheet
Dim lngRows As Long



For Each ws In ActiveWorkbook.Worksheets

lngRows = ActiveSheet.Rows.Count
ActiveSheet.Range("a1").Select

i = 1
Do While Cells(i, "a").Value <> ""

If Worksheets(1).Range("e3").Value = Cells(i, "a").Value Then
If Worksheets(1).Range("e6").Value = "" Then
Cells(i, "a").Resize(, 2).Copy Destination:=Worksheets(1).Range("e6")
Else:
Cells(i, "a").Resize(, 2).Copy Destination:=Worksheets(1).Range("e5").End(xlDown).Offset(1, 0)
End If

End If

i = i + 1

If i = lngRows Then
Exit Do
End If

Loop
'E.g.
'On Error Resume Next 'Will continue if an error results
'ws.Range("A1") = ws.Name
Next ws
End Sub

Thank you in advance!

mdmackillop
01-23-2009, 03:42 PM
You need to make references to each sheet, otherwise the code keeps referring to the active sheet
Sub Proba()
Dim i As Long
Dim ws As Worksheet
Dim lngRows As Long

For Each ws In ActiveWorkbook.Worksheets
With ws
lngRows = ws.Rows.Count
ws.Range("a1").Select
i = 1
Do While .Cells(i, "a").Value <> ""
If Worksheets(1).Range("e3").Value = .Cells(i, "a").Value Then
If Worksheets(1).Range("e6").Value = "" Then
.Cells(i, "a").Resize(, 2).Copy Destination:=Worksheets(1).Range("e6")
Else
.Cells(i, "a").Resize(, 2).Copy Destination:=Worksheets(1).Range("e5").End(xlDown).Offset(1, 0)
End If

End If
i = i + 1
If i = lngRows Then
Exit Do
End If
Loop
'E.g.
'On Error Resume Next 'Will continue if an error results
'ws.Range("A1") = ws.Name
End With
Next ws
End Sub

mdmackillop
01-23-2009, 03:54 PM
Sub Proba()
Dim ws As Worksheet
Dim ToFind
Dim MyE6
Dim c As Range

ToFind = Worksheets(1).Range("e3").Value
Set MyE6 = Worksheets(1).Range("e6")

For Each ws In ActiveWorkbook.Worksheets
Set c = ws.Columns(1).Find(ToFind)
If Not c Is Nothing Then
If MyE6 = "" Then
c.Resize(, 2).Copy MyE6
Else
c.Resize(, 2).Copy Worksheets(1).Range("e5").End(xlDown).Offset(1, 0)
End If
End If
Next ws
End Sub

hunsnowboard
01-24-2009, 12:50 AM
Hi Mdmckillop! Thank you (again) for your help! I will try the code now. Have a nice weekend! :)