Run macro in all worksheets

[vidaLL]

Hello guys.

Could you help me with this case. I'm not getting the macro to run on all worksheets.

I made many attempts but without sucess...

Follow the code and the workbook. 11681

Sub BuscaSQL1()
'Selection.ClearContents
Dim ConecaoPlan As New ADODB.Connection
Dim rsConsulta As New ADODB.Recordset
Dim Caminho As String
Dim Roda As Integer
Dim sql As String
'Dim ws_count As Integer
'Dim I As Integer
'''Dim sheet As Worksheet
'''Dim book As Workbook
''''Dim ws As Worksheet

Caminho = ActiveWorkbook.Path & "\2110(2).xlsm"
ConecaoPlan.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source= " & Caminho & ";Extended Properties=Excel 8.0;" '";Extended Properties=Excel 12.0 Xml;HDR=YES;"Extended Properties=Excel 8.0
ConecaoPlan.Open

'ws_count = ActiveWorkbook.Worksheets.Count
'For I = 1 To ws_count

''For Each sheet In ThisWorkbook.Sheets
'''For Each sheet In book.Worksheets

''''For Each ws In Sheets

'Primeira Parte
Range("B10").Select

Do While ActiveCell.Value <> "Total AR"
sql = "Select * From [MontaBase$] Where Dado1 Like '" & ActiveCell.Value & "'"
rsConsulta.Open sql, ConecaoPlan, adOpenKeyset, adLockOptimistic
If rsConsulta.RecordCount > 0 Then
For Roda = 1 To (rsConsulta.RecordCount * 5) Step 5
Cells(ActiveCell.Row, ActiveCell.Column + Roda).Value = rsConsulta!Dado2
rsConsulta.MoveNext
Next
End If
rsConsulta.Close
Cells(ActiveCell.Row + 1, ActiveCell.Column).Select
Loop
'Segunda Parte
Range("B23").Select

Do While ActiveCell.Value <> "Cash Receipts"
sql = "Select * From [MontaBase$] Where Dado3 Like '" & ActiveCell.Value & "'"
rsConsulta.Open sql, ConecaoPlan, adOpenKeyset, adLockOptimistic
If rsConsulta.RecordCount > 0 Then
For Roda = 1 To (rsConsulta.RecordCount * 5) Step 5
Cells(ActiveCell.Row, ActiveCell.Column + Roda).Value = rsConsulta!Dado4
rsConsulta.MoveNext
Next
End If
rsConsulta.Close
Cells(ActiveCell.Row + 1, ActiveCell.Column).Select
Loop

'Terceira Parte
Range("B30").Select

Do While ActiveCell.Value = " "
sql = "Select * From [MontaBase$] Where Dado5 Like '" & ActiveCell.Value & "'"
rsConsulta.Open sql, ConecaoPlan, adOpenKeyset, adLockOptimistic
If rsConsulta.RecordCount > 0 Then
For Roda = 3 To ((3 + rsConsulta.RecordCount) * 4) Step 5
Cells(ActiveCell.Row, ActiveCell.Column + Roda).Value = rsConsulta!Dado6
rsConsulta.MoveNext
Next
End If
rsConsulta.Close
Cells(ActiveCell.Row + 1, ActiveCell.Column).Select
Loop
'Next I
''Next sht
'''Next sheet
''''Next ws
Set ConecaoPlan = Nothing
Set rsConsulta = Nothing
End Sub

[ranman256]

Those ALL work, but you must make XL go to the sheet after you assign it.



For Each ws In Sheets
ws.select
next

[vidaLL]

True true... :banghead:

tks for your help !