A macro to copy/paste a cell and other cells in the same row [Solved/Closed]
tanja20 -
May 5, 2017 at 07:39 AM - Latest reply: TrowaD2369
Posts Sunday September 12, 2010Registration dateModeratorStatus
June 21, 2018
Last seen
- May 9, 2017 at 11:12 AM
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
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)
thank you very much for your tip. It works now!
Best regards,
Tanja