Copy to another sheet based on values

[JDVOIGT]

I am building a P&L on worksheet(1) based on data from worksheet(2). I need to copy rows of data from worksheet(2) and paste onto worksheet(1). The pasting process needs to find a named range (one cell) on worksheet(1) and insert a row for the copied data above the named cell. In addition, each row on worksheet(2) must first be identified by a cell value in row (d) and be pasted to a corresponding named cell.

Source = Worksheet(2)
Destination Worksheet(1)

Worksheet(2) and has hundreds of rows
Worksheet(2) column (d) has the identifier value(s), like 1000 and 1100, which both need to go to the gross sales section on worksheet(1) –the code below only has 1000.
Worksheet(1) has a named range called RPT_GS. The copied data needs to be inserted above the named range RPT_GS.

The code below is a mess and does not find the named range RPT_GS. If the below code is so ugly, please feel free to start over. I really appreciate any help. Thanks, John


Sub FIND_COPY_PASTE_1000()

Dim DestSheet As Worksheet
Set DestSheet = Worksheets("sheet 1")

Dim sRow As Long
Dim dRow As Long
Dim sCount As Long
sCount = 0
dRow = 1

For sRow = 1 To Range("D360").End(xlUp).Row
If Cells(sRow, "D") Like "1000" Then
sCount = sCount + 0
dRow = dRow + 1

'Cells(sRow, "F").Copy Destination:=DestSheet.Cells(dRow, "B")
'Cells(sRow, "E").Copy Destination:=DestSheet.Cells(dRow, "C")
'Cells(sRow, "D").Copy Destination:=DestSheet.Cells(dRow, "D")


End If
Next sRow

[VBWheaties]

I am building a P&L on worksheet(1) based on data from worksheet(2). I need to copy rows of data from worksheet(2) and paste onto worksheet(1). The pasting process needs to find a named range (one cell) on worksheet(1) and insert a row for the copied data above the named cell. In addition, each row on worksheet(2) must first be identified by a cell value in row (d) and be pasted to a corresponding named cell.

Source = Worksheet(2)
Destination Worksheet(1)

Worksheet(2) and has hundreds of rows
Worksheet(2) column (d) has the identifier value(s), like 1000 and 1100, which both need to go to the gross sales section on worksheet(1) –the code below only has 1000.
Worksheet(1) has a named range called RPT_GS. The copied data needs to be inserted above the named range RPT_GS.

The code below is a mess and does not find the named range RPT_GS. If the below code is so ugly, please feel free to start over. I really appreciate any help. Thanks, John


Sub FIND_COPY_PASTE_1000()

Dim DestSheet As Worksheet
Set DestSheet = Worksheets("sheet 1")

Dim sRow As Long
Dim dRow As Long
Dim sCount As Long
sCount = 0
dRow = 1

For sRow = 1 To Range("D360").End(xlUp).Row
If Cells(sRow, "D") Like "1000" Then
sCount = sCount + 0
dRow = dRow + 1

'Cells(sRow, "F").Copy Destination:=DestSheet.Cells(dRow, "B")
'Cells(sRow, "E").Copy Destination:=DestSheet.Cells(dRow, "C")
'Cells(sRow, "D").Copy Destination:=DestSheet.Cells(dRow, "D")


End If
Next sRow

Is it not working or something? Not sure what the issue is.

[kadghar]

I am building a P&L on worksheet(1) based on data from worksheet(2). I need to copy rows of data from worksheet(2) and paste onto worksheet(1). The pasting process needs to find a named range (one cell) on worksheet(1) and insert a row for the copied data above the named cell. In addition, each row on worksheet(2) must first be identified by a cell value in row (d) and be pasted to a corresponding named cell.

...

Your code doesnt seem that bad; the problems i think you might be having are:

1. When you run the code, you have to make sure your active sheet is the second, or (a better solution) use it as the parent of the cells while searching.
2. Range("D360").End(xlUp).Row means: You stand in cell D360, then you press Ctrl+upArrow and then you see the row number. If you have no empty spaces in column D, that'll be the first row, and your FOR will go from 1 to 1. Maybe you want to use .End(xlDown)
3. When you make the copy-paste, you're not inserting a new row, may be you want to insert it before you copy-paste.

With some luck, something like this will solve this three problems:

Sub FIND_COPY_PASTE_1000()
 
  Dim DestSheet  As Worksheet
  Set DestSheet = Worksheets("sheet 1")
 
  Dim sRow       As Long   
  Dim dRow       As Long     
  Dim sCount     As Long
  sCount = 0
  dRow = 1
with worksheets("sheet2")
  For sRow = 1 To Range("D360").End(-4121).Row '-4121 is the numerical value of xlDown, inside excel, they're the same, outside excel, only the numeric value is good.
        If .Cells(sRow, "D") Like "1000" Then
        sCount = sCount + 0
        dRow = dRow + 1
        Rows(dRow).Insert Shift:=-4121 
        .Cells(sRow, "F").Copy Destination:=DestSheet.Cells(dRow, "B")
        .Cells(sRow, "E").Copy Destination:=DestSheet.Cells(dRow, "C")
        .Cells(sRow, "D").Copy Destination:=DestSheet.Cells(dRow, "D")
     End If
  Next sRow
end with
end sub

[JDVOIGT]

Sorry, the problem is when the 1000 value is found in sheet2 row d, i need the macro to insert a row for each time it finds a 1000 (and copy the entire row the 1000 is contained in).

Thanks!

[kadghar]

Sorry, the problem is when the 1000 value is found in sheet2 row d, i need the macro to insert a row for each time it finds a 1000 (and copy the entire row the 1000 is contained in).

Thanks!

the code i've just posted will do that ^.^
just change the .end(-4121) to your original .end(xlup)