robti
robti

Reputation: 15

For cycle only loops once and crashes

I'm trying to do a macro where VBA looks for a specific word in a column and when it finds the words, it copies the entire row from one workbook to another. It can find the word more then once, so I'm trying to make it loop though it only loops ONCE in the for cycle and then stops.

Here is the for.

Application.Workbooks.Open ("C:\Documents and Settings\1848052\Mis documentos\Portafolios\Vistas\Portafolio.xlsm")
i = 9

For j = 8 To 1000
    celda = Workbooks("Portafolio.xlsm").Sheets("FemCo").Range("B" & j).Value

    If celda = area Then
        Workbooks("Portafolio.xlsm").Sheets("FemCo").Range("B" & j).Select
        fila = ActiveCell.Row

        Windows("Portafolio.xlsm").Activate         ' Copiar row
        Range("A" & fila & ":" & "V" & fila).Select
        Selection.Copy

        Windows("Vista RPAs.xlsm").Activate        'Pegar row
        Range("B" & i & ":W" & i).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Application.CutCopyMode = False

        i = i + 1
    End If
Next

As I mentioned before, it only loops once and then this:

Workbooks("Portafolio.xlsm").Sheets("FemCo").Range("B" & j).Select

is the part that crashes and I get "Error 1004". How do you think I could fix this error?

Thanks in advance.

Upvotes: 1

Views: 70

Answers (2)

Dmitry Pavliv
Dmitry Pavliv

Reputation: 35853

You can use this code instead. It avoids using For j=8 to 1000 statement (it uses Find method instead - it's much better when you have many rows).

Sub test()
   Application.ScreenUpdating = False
   Workbooks.Open ("C:\Documents and Settings\1848052\Mis documentos\Portafolios\Vistas\Portafolio.xlsm")
   i = 9

   With Workbooks("Portafolio.xlsm").Sheets("FemCo")
       Set c = .Range("B8:B1000").Find(area, LookIn:=xlValues)
       If Not c Is Nothing Then
           firstAddress = c.Address
           Do
               Workbooks("Vista RPAs.xlsm").ActiveSheet.Range("B" & i & ":W" & i).Value = _
                .Range("A" & c.Row & ":" & "V" & c.Row).Value
               i = i + 1
               Set c = .Range("B8:B1000").FindNext(c)
           Loop While Not c Is Nothing And c.Address <> firstAddress
       End If
   End With
   Workbooks("Portafolio.xlsm").Close
   Application.ScreenUpdating = True
End Sub

Note that it's better to change Workbooks("Vista RPAs.xlsm").ActiveSheet to Workbooks("Vista RPAs.xlsm").Sheets("SomeSheetName")

Upvotes: 1

Cheeky Charlie
Cheeky Charlie

Reputation: 106

Simoco got it first time, selecting in a non-active workbook. (just the if block)

    Workbooks("Portafolio.xlsm").Sheets("FemCo").Range("A" & fila & ":" & "V" & fila).Copy

    Workbooks("Vista RPAs.xlsm").activesheet.Range("B" & i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Application.CutCopyMode = False

btw, tidied up with some valid points, but the 'better' way to do this would be to run a loop around a find statement, which searches the relevant range for hte word you want, and exits when the first found record is found again, or no records are found, There are plenty of examples of this.

Upvotes: 1

Related Questions