Please help me fix coding and create a loop to it

[Galego]

Hello,

I have made the below code but I can't figure out how to loop it.

What I would like the below code to do is....if value in column N in Workbooks("Data.xlsx").Sheets("Data") is bigger than 10000 then copy the cell D in than same row and paste it wsMacro.Range("A" & nr)

For me only works now if I do for one only cell.

Hope someone can help me. If unclear please let me know.



<code>

Sub Macro1()


Dim wsData As Worksheet
Dim wsMacro As Worksheet
Dim nr As Long, lr As Long
Dim c As Range



Set wsData = Workbooks("Data.xlsx").Sheets("Data")
Set wsMacro = Workbooks("Over 50k Report (testing).xlsm").Sheets("NEW Invoices")


lr = wsData.Range("D" & Rows.Count).End(xlUp).Row
nr = wsMacro.Range("A" & Rows.Count).End(xlUp).Row + 1


For Each c In wsData.Range("N246")
If c.Value > 10000 Then


'copy the row
wsData.Range("D246").Copy

'paste the row
wsMacro.Range("A" & nr).PasteSpecial xlPasteAll
'set next row number
nr = nr + 1



End If
Next c
End Sub

</code>

 

[Joe4]

You are only looping through one cell (N246).

[COLOR=#333333][FONT=monospace]For Each c In wsData.Range("N246")
[/FONT][/COLOR]

You need to expand your range, so it includes more than one cell in column N.

Then, whatever range that is, you can use Offset to update column D of the same row, i.e.

[COLOR=#333333][FONT=monospace]For Each c In wsData.MyRange[/FONT][/COLOR]
[COLOR=#333333][FONT=monospace]If c.Value > 10000 Then[/FONT][/COLOR]


[COLOR=#333333][FONT=monospace]'copy the value from column D of same row[/FONT][/COLOR]
[COLOR=#333333][FONT=monospace]c.Offset(0,-10).Copy[/FONT][/COLOR]

 

[mumps]

This macro should do what you want without looping. It assumes that your data starts in row 2 with headers in row 1. If this is not the case, the macro will have to be modified. Joe4 explained the confusion.

Sub CopyRows()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    Dim wsData As Worksheet
    Dim wsMacro As Worksheet
    Set wsData = Workbooks("Data.xlsx").Sheets("Data")
    Set wsMacro = Workbooks("Over 50k Report (testing).xlsm").Sheets("NEW Invoices")
    LastRow = wsData.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    wsData.Range("N1:N" & LastRow).AutoFilter Field:=1, Criteria1:=">10000"
    wsData.Range("N2:N" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Copy wsMacro.Cells(wsMacro.Rows.Count, "A").End(xlUp).Offset(1, 0)
    If wsData.AutoFilterMode = True Then wsData.AutoFilterMode = False
    Application.ScreenUpdating = True
End Sub

 

[Galego]

Going to give mumps coding a go thanks!

 

[Galego]

@mumps

Works like a dream, thanks!

How could I make it copy only a cell in the row as opposite to the entire row?

In my case I am trying to copy value in Column D in that same row that the if is met.

 

[mumps]

Replace this line of code:

wsData.Range("N2:N" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Copy wsMacro.Cells(wsMacro.Rows.Count, "A").End(xlUp).Offset(1, 0)

with this line:

wsData.Range("D2:D" & LastRow).SpecialCells(xlCellTypeVisible).Copy wsMacro.Cells(wsMacro.Rows.Count, "A").End(xlUp).Offset(1, 0)

 

[Galego]

Replace this line of code:

wsData.Range("N2:N" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Copy wsMacro.Cells(wsMacro.Rows.Count, "A").End(xlUp).Offset(1, 0)

with this line:

wsData.Range("D2:D" & LastRow).SpecialCells(xlCellTypeVisible).Copy wsMacro.Cells(wsMacro.Rows.Count, "A").End(xlUp).Offset(1, 0)

Excellent many thanks!

 

[mumps]

My pleasure.