loop through rows on separate sheets and copy data

[stirlingmw1]

Morning all

I have been trying for a couple of days now but seem to get the same results each time, please help.

I have a sheet "prepared" within my workbook with 2 separate ranges (A1:A50) and (A51:C100) that could contain data, I would like to loop through these ranges and if data is present in each row, copy certain cells of data from them onto another sheet "Uplifts" to make up a new row of data. So column B and C from the first set of rows would be copied to columns C and D of "Uplifts" and column C of the second range would be copied into column G of "Uplifts".
Each new row of data in the ranges would be copied into the next empty row in "Uplifts"

I have been trying to get this code to work, but it just adds the data over the top of the previous when it loops. Additionally this code would take the first 2 columns of data from another sheet which I do not want it to do, but i couldn't get the last row of each range, just the last row of all of the ranges combined.

Sub RecordUplift()

Dim WsC As Worksheet
Dim WsU As Worksheet
Dim WsP As Worksheet
Dim NeRowU As Long

Set WsC = Sheets("Copy")
Set WsU = Sheets("Uplifts")
Set WsP = Sheets("prepared")

NeRowU = WsU.Range("A" & Rows.Count).End(xlUp).Row + 1

RowCount = WsC.cells(Rows.Count, "A").End(xlUp).Row + 1

For i = 1 To RowCount
    If Range("A1") <> "" Then
        WsU.Range("C" & NeRowU).Value = WsP.Range("B" & i).Value
  
    End If
Next i

End Sub

TIA

Steve

 

[Akuini]

@stirlingmw1

Set WsC = Sheets("Copy")

You didn't mention Sheets("Copy") in your explanation. So what does it do?
It would be helpful if you can post an example along with the expected result.

 

[stirlingmw1]

@stirlingmw1

Set WsC = Sheets("Copy")

You didn't mention Sheets("Copy") in your explanation. So what does it do?
It would be helpful if you can post an example along with the expected result.

Akuini

Apologies, I didnt explain it too well. The final para mentions another sheet but doesnt name it, "Additionally this code would take the first 2 columns of data from another sheet". this is the "Copy" sheet. The reason I was using "Copy" was because in the "prepare" sheet I have 2 ranges of data that could populate A1 to C50 and then a second set that could populate range A51 to C100, but every time i tried to find the last used row of each range it found the last row of both ranges added together and not the last row or each range.

So the first 2 cells of data would come from columns B and C row 1 to last used row of the first range and the next cells of data from rows 51 to last used row of the 2nd range.

Again, i hope I have explained that correctly.

Regards

Steve

 

[Akuini]

Try this:
You don't need Sheets("Copy")

Sub RecordUplift()
'https://www.mrexcel.com/board/threads/loop-through-rows-on-separate-sheets-and-copy-data.1179571/

Dim WsC As Worksheet
Dim WsU As Worksheet
Dim WsP As Worksheet
Dim NeRowUc As Long
Dim NeRowUg As Long
Dim a1 As Long, a2 As Long
Dim c As Range

Application.ScreenUpdating = False
'Set WsC = Sheets("Copy")
Set WsU = Sheets("Uplifts")
Set WsP = Sheets("prepared")

a1 = WsP.Range("A1:A50").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
a2 = WsP.Range("A51:A100").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

NeRowUc = WsU.Range("C" & Rows.Count).End(xlUp).Row + 1
NeRowUg = WsU.Range("G" & Rows.Count).End(xlUp).Row + 1

For Each c In WsP.Range("A1:A" & a1)
    If c <> "" Then
        WsU.Range("C" & NeRowUc).Resize(, 2).Value = WsP.Range("B" & c.Row).Resize(, 2).Value
        NeRowUc = NeRowUc + 1
    End If
Next

For Each c In WsP.Range("A51:A" & a2)
    If c <> "" Then
        WsU.Range("G" & NeRowUg).Value = WsP.Range("C" & c.Row).Value
        NeRowUg = NeRowUg + 1
    End If
Next
Application.ScreenUpdating = True

End Sub