PDA

View Full Version : [SOLVED:] Copy, Find Match in another worksheet, and then Paste Range



Sully1440
09-27-2020, 03:59 PM
Hey All,
I'm trying to Copy on one sheet, Find Match in another worksheet, and then Paste the Range on this other sheet. But I'm really stuck!!

Sub PROJECT_BACKUP()
Dim Fnd As Range
Dim RngY As Variant

Sheets("PROJECT PROGRESS").Select
RngY = Range("D2").Copy

Set Fnd = Sheets("DATABASE").Columns("C:L").Find(RngY, , xlFormulas, xlWhole, xlByRows, xlNext, False, , False)
If Not Fnd Is Nothing Then ActiveCell.Offset(, 1).Value = Fnd.Offset(, 1).Value
ActiveCell.Offset(, 1).Value = Fnd.Offset(, 7).Paste

Range("A2").Select
Application.CutCopyMode = False
End Sub


I attached an example of what I'm attempting.
Any help out there would be very appreciated.
Thx,
Jim

Sully1440
09-28-2020, 05:26 AM
Hi All,
I tried the following code but I can't seem to get the 'Find' working....it pastes the range in the wrong area.

Sub PROJECT_BACKUP()

Dim rng As Range
Dim rng2 As Range
Dim strText
Dim DatabaseLastRow As Long

Sheets("PROJECT PROGRESS").Select
strText = Range("D2").Value
Range("H9:M33").Select
Selection.Copy

Sheets("DATABASE").Select
Set rng = Range("C7:C1000").Find(What:=strText, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
ActiveCell = rng
ActiveCell.Offset(0, 7).Select
ActiveCell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Range("A2").Select

Application.CutCopyMode = False
End Sub


Anyone have any ideas?

Sully1440
09-28-2020, 06:30 AM
I got it figured...............

Sub PROJECT_STORE()

Dim rng As Range
Dim strText

Sheets("PROJECT PROGRESS").Select
strText = Range("D2").Value
Range("H9:M33").Select
Selection.Copy
Range("A2").Select

Sheets("DATABASE").Select
Set rng = Range("C4:C1000").Find(What:=strText, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
'Cells(1, 1) = rng.Address

rng.Select

ActiveCell.Offset(0, 4).Select
ActiveCell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Range("A2").Select
Sheets("PROJECT PROGRESS").Select

Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub