A macro to copy/paste a cell and other cells in the same row [Solved/Closed]

Report
-
Posts
2631
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
July 6, 2020
-
I have two wooksheets in a workbook. I need that a value of each cell in a range C3:C52 in sheet 2002 is being searched for in the range B2:B101 of the sheet Rawdata. When found, the value of the cell in the range B2:B101 of the sheet Rawdata and the next cell in the same row (or a complete row with cells that are not empty) must be copied and pasted in the sheet 2002 next to the cell which value was searched for.

I have modified code which I found in the Internet. But with modifications it doesn't work.

Sub Find_Copy_Paste()

Dim sh1 As Worksheet, sh2 As Worksheet
Dim rng1 As Range, rng2 As Range
Dim cell As Range, FoundCells As Range
Dim row As Range
Set sh1 = Worksheets("2002")
Set sh2 = Worksheets("Rawdata")
Set rng1 = sh1.Range("C3:C52")
Set rng2 = sh2.Range("B2:B101")
For Each cell In rng1
If Not IsEmpty(cell) Then
Set FoundCells = rng2.Find(cell.Value)
If Not FoundCells Is Nothing Then
' Copy Found cell to one column on right of cell being searched for
FoundCells.EntireRow.Copy Destination:=cell.Offset(0, 1)
End If
End If
Next
Set rng1 = Nothing
Set rng2 = Nothing
Set sh1 = Nothing
Set sh2 = Nothing

End Sub

1 reply

Posts
2631
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
July 6, 2020
428
Hi Tanja,

You can't paste an entire row in column B, it won't fit. You will need to adjust:
FoundCells.EntireRow.Copy Destination:=cell.Offset(0, 1)
into maybe:
range(cells(foundcells.row,"B"),cells(foundcells.row,"C")).copy cell.offset(0,1)

Best regards,
Trowa
Hi Trowa,

thank you very much for your tip. It works now!

Best regards,
Tanja
Posts
2631
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
July 6, 2020
428
Awesome! Thanks for the feedback.