For nested parallel VBA Excel

0

I'm doing a For in another For , where it runs per column, finds the cell and copies, in the other For it runs column as well and it queues in a range. However, the code is executing a whole For first and then executing the other and executing the two (copying and pasting).

Can you help me? Below is the code I've made ...

SUB ()

Set Cop = Workbooks(Arq)
L = Cop.Sheets("Consolidado_Vendas_TFN").Range("J1048576").End(xlUp).Row

   For w = 15 To 135

        If Cells(6, w) <> "" Then
           Cells(6, w).Copy

        End If

            For y = 18 To 138

                If Cells(8, y) = "" Then
                   Sheets("Consolidado_Vendas_TFN").Range(Cells(8, y), Cells(L, y)).PasteSpecial xlValues

                   w = w + 4
                   y = y + 4

                End If


        If w = 136 And y = 139 Then

            Exit For
    Exit For

            Else
                w = w - 1
                y = y - 1

        End If

        Next y
    Next w

END SUB
    
asked by anonymous 05.10.2017 / 01:17

2 answers

0

A for loop

Not necessary Using copy / paste, as it is slower than simply writing, for 100 lines is feasible. But for more than 20,000 rows it can become slow.

Spreadsheet actions can be achieved only with a for loop, without the need for nested for loops.

Sub teste()

Set Cop = Workbooks(Arq)
L = Cop.Sheets("Consolidado_Vendas_TFN").Range("J1048576").End(xlUp).Row

   For w = 15 To 135 Step 4
        y = w + 3
        If Cells(6, w) <> "" And Cells(8, y)="" Then
           Sheets("Consolidado_Vendas_TFN").Range(Cells(8, y), Cells(L, y)) = Cells(6, w)
        End If

        If w = 136 And y = 139 Then
            Exit For
            Else
                w = w - 1
                y = y - 1
        End If
    Next w

End Sub
  • w = w + 4 can be replaced by Step 4
  • Since the relation of w to y is y = w + 3, the other one can be removed
  • If If can contain more than one condition, using operators such as E(And) .

Note: I do not understand what this part is for:

    If w = 136 And y = 139 Then
        Exit For
        Else
            w = w - 1
            y = y - 1
    End If

Using Copy / Paste

Set Cop = Workbooks(Arq)

   For w = 15 To 135 Step 4
    ultimaLinha = Cop.Sheets("Consolidado_Vendas_TFN").Cells(Cop.Sheets("Consolidado_Vendas_TFN").Rows.Count, w).End(xlUp).Row
        y = w + 3
        If Cells(6, w) <> "" And Cells(8, y) = "" Then
            Sheets("Consolidado_Vendas_TFN").Cells(6, w).Copy
            Sheets("Consolidado_Vendas_TFN").Range(Cells(8, y), Cells(L, y)).PasteSpecial xlValues
        End If
    Next w
    
05.10.2017 / 13:58
0

Daniel, Thank you very much for the help !!! I just made a small change, because I really need to copy from a cell and paste it into a range.

Only this part needed to change ...

If Cells(6, w) <> "" And Cells(8, y) = "" Then
   Sheets("Consolidado_Vendas_TFN").Cells(6, w).Copy
   Sheets("Consolidado_Vendas_TFN").Range(Cells(8, y), Cells(L, y)).PasteSpecial xlValues
End If
    
05.10.2017 / 16:06