Help jump Columns

[vidaLL]

Hi all.
I need a little help with my Sheets.

11505

If you put the Sheets in your desktop and click in the button(TEST) in Plan1 Sheet ,
will start to fill in the fields.

However I would like each of the values were filled in the column painted in blue.

Any doubt let me know.

Ty all

[Bob Phillips]

Sub BuscaSQL1()
Dim ConecaoPlan As ADODB.Connection
Dim rsConsulta As ADODB.Recordset
Dim Caminho As String
Dim Roda As Integer
Dim sql As String

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

With Range("B10")

Do While ActiveCell.Value <> "Total AR"

sql = "Select * From [MontaBase$] Where Dado1 Like '" & ActiveCell.Value & "'"
Set rsConsulta = ConecaoPlan.Execute(sql)

If rsConsulta.RecordCount > 0 Then

For Roda = 1 To 28 Step 5

Cells(.Row, .Column + Roda).Value = rsConsulta!Dado2
rsConsulta.MoveNext
Next
End If

rsConsulta.Close
Loop
End With

Set ConecaoPlan = Nothing
Set rsConsulta = Nothing
End Sub

[vidaLL]

Sub BuscaSQL1()
Dim ConecaoPlan As ADODB.Connection
Dim rsConsulta As ADODB.Recordset
Dim Caminho As String
Dim Roda As Integer
Dim sql As String

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

With Range("B10")

Do While ActiveCell.Value <> "Total AR"

sql = "Select * From [MontaBase$] Where Dado1 Like '" & ActiveCell.Value & "'"
Set rsConsulta = ConecaoPlan.Execute(sql)

If rsConsulta.RecordCount > 0 Then

For Roda = 1 To 28 Step 5

Cells(.Row, .Column + Roda).Value = rsConsulta!Dado2
rsConsulta.MoveNext
Next
End If

rsConsulta.Close
Loop
End With

Set ConecaoPlan = Nothing
Set rsConsulta = Nothing
End Sub



Thanks very much . It Works like a charm.

[vidaLL]

Let's think there is already filled data in this spreadsheet (Annex) and this new information will be filled by the macro, keeping the information that was already filled.
Any idea how can I do this?

11548

Thanks again.