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. GERAL.zip

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...

tks for your help !