loop through rows on separate sheets and copy data

stirlingmw1

Board Regular
Joined
Jun 17, 2016
Messages
50
Office Version
  1. 2016
  2. 2013
  3. 2010
  4. 2007
Platform
  1. Windows
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.

VBA Code:
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
 

Excel Facts

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
3,555
Office Version
  1. 365
Platform
  1. Windows
@stirlingmw1
VBA Code:
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

Board Regular
Joined
Jun 17, 2016
Messages
50
Office Version
  1. 2016
  2. 2013
  3. 2010
  4. 2007
Platform
  1. Windows
@stirlingmw1
VBA Code:
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

Well-known Member
Joined
Feb 1, 2016
Messages
3,555
Office Version
  1. 365
Platform
  1. Windows
Try this:
You don't need Sheets("Copy")
VBA Code:
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
 
Solution

Forum statistics

Threads
1,148,160
Messages
5,745,122
Members
423,927
Latest member
Pra56

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top