Do until Loop on another workbook

[Catri]

Hi,

I want to loop until the last cell in another workbook. Both workbooks are open. Here is some of my code. I can't get the loop until part to stop at the named range of Wk2. any help would be appreciated.

Set Wk1 = ThisWorkbook
Compare = InputBox("Favor selecionar a data para comparaçao (dd_mm_aa) :")
Workbooks.Open Filename:="L:\sumprimentos\Catherine\Tasks\Transito desembaraço\" & Compare & "_FIAT"

Set Wk2 = ActiveWorkbook
Wk2.Names.Add Name:="lastcell", RefersTo:=Range("A65536").End(xlUp)



Range("A11").Select

Do
Wk2.Activate
If ActiveCell.Interior.ColorIndex = 36 Then GoTo 12 Else GoTo 11

12
ActiveCell.Copy
ActiveCell.Offset(1, 0).Select
Wk1.Activate
ActiveCell.Select
Selection.PasteSpecial Paste:=xlPasteValues
11
ActiveCell.Offset(1, 0).Select

Loop Until Workbooks("Wk2").Sheets("SDM PM FIAT").Range(lastcell)


Thanks!

 

[b.downey]

Here is some code that will open Worksheet2 and loop thur it from Row 11 to the Last Active Row. It also performs the test that you need for interior color 36

You will need to add the code to copy the information from wk2 to wk1.

Sub Test()
    Dim Wk1 As Worksheet
    Dim Wk2 As Worksheet
    Dim Wk2RowNo As Long
    Dim Wk2LastRowNo As Long
 
    Workbooks.Open Filename:="L:\sumprimentos\Catherine\Tasks\Transito desembaraço\" & Compare & "_FIAT"
    Set Wk2 = ActiveSheet
    'Find the last Row in Worksheet 2
    Wk2LastRowNo = Wk2.Cells(Wk2.Rows.Count, "A").End(xlUp).Row
 
    'Look thru Worksheet2 starting at row 11 to the Last row
    For Wk2RowNo = 11 To Wk2LastRowNo
        If Wk2.Cells(Wk2RowNo, "A").Interior.ColorIndex = 36 Then
            'Do the copy and paste
        Else
            '?
        End If
 
    Next Wk2RowNo

Also, there is really no need to "Activate" the cells in each of the two worksheets. In fact it is more effecient not to activate the cell but simply refer to the cell.

 

[Catri]

Re: [SOLVED]Do until Loop on another workbook

Thanks for your reply! I actually got this code to work, but I think I'll use yours instead. Its so much simpler!!

Set Wk1 = ActiveWorkbook
    Sheets.Add
 
    Range("A1").Select
    Compare = InputBox("Favor selecionar a data para comparaçao (dd_mm_aa) :")
Workbooks.Open Filename:="L:\sumprimentos\Catherine\Tasks\Transito desembaraço\" & Compare & "_FIAT"
  Set Wk2 = ActiveWorkbook
 Dim lngLastRow As Long
   Dim n As Integer
   n = n + 1
   lngLastRow = Range("A" & Rows.Count).End(xlUp).Row
 
 Range("A11").Select
 
  Do
   Wk2.Activate
   If ActiveCell.Interior.ColorIndex = 36 Then GoTo 12 Else GoTo 11
 
12
   ActiveCell.Copy
   Wk1.Activate
   ActiveCell.Select
   Selection.PasteSpecial Paste:=xlPasteValues
   ActiveCell.Offset(1, 0).Select
11
 Wk2.Activate
 ActiveCell.Offset(1, 0).Select
n = n + 1
Loop Until n = lngLastRow - 11
 
End Sub

Here is some code that will open Worksheet2 and loop thur it from Row 11 to the Last Active Row. It also performs the test that you need for interior color 36

You will need to add the code to copy the information from wk2 to wk1.

Sub Test()
    Dim Wk1 As Worksheet
    Dim Wk2 As Worksheet
    Dim Wk2RowNo As Long
    Dim Wk2LastRowNo As Long
 
    Workbooks.Open Filename:="L:\sumprimentos\Catherine\Tasks\Transito desembaraço\" & Compare & "_FIAT"
    Set Wk2 = ActiveSheet
    'Find the last Row in Worksheet 2
    Wk2LastRowNo = Wk2.Cells(Wk2.Rows.Count, "A").End(xlUp).Row
 
    'Look thru Worksheet2 starting at row 11 to the Last row
    For Wk2RowNo = 11 To Wk2LastRowNo
        If Wk2.Cells(Wk2RowNo, "A").Interior.ColorIndex = 36 Then
            'Do the copy and paste
        Else
            '?
        End If
 
    Next Wk2RowNo

Also, there is really no need to "Activate" the cells in each of the two worksheets. In fact it is more effecient not to activate the cell but simply refer to the cell.

 

[b.downey]

Thank for the feedback. Glad I could help