Find match from range and copy/paste values to destination row where match found

[Energizey]

Hi All,

I am very new to VBA and would be super grateful for help with some code I am trying to make work.

I need the code to do the following -

• 1. From Source range E19:E29 look for exact match to values in Destination range A4:A55,
  2. When exact match is found copy the values from Source range F19:Q29 and paste values to Destination range F4:Q55.
  3. From Source range E33:E43 look for exact match to values in Destination range A101:A146,
  4. When exact match is found copy the values from Source range F33:Q43 and paste values to Destination range F101:Q146.
  
  

The code I have found and adapted from the internet is as follows - I have only tried to tackle actions 1 and 2 above so far:

Option Explicit

Sub SubmitSubModalityBudget()
Dim lCurRow As Long
Dim lHit As Long
Dim shtSource As Worksheet
Dim shtDest As Worksheet
Dim cmt As Comment
Dim zHoldCmt As String

Set shtDest = ActiveWorkbook.Sheets("Karisma Raw Data Sheet")
Set shtSource = ActiveWorkbook.Sheets("Revenue_Services Calculation")

shtDest.Activate
lCurRow = 4 'Starting row in the Destination sheet.
lHit = 0 'Initialize the found match variable

Do
On Error Resume Next
lHit = WorksheetFunction.Match(Cells(lCurRow, 2), _
shtSource.Range("E19:E29"), 0)
On Error GoTo 0

If lHit > 0 Then
'Check for comment in matched source cell
Set cmt = shtSource.Cells(lHit, 1).Comment

If Not (cmt Is Nothing) Then
'Save the found comment text
zHoldCmt = shtSource.Cells(lHit, 1).Comment.Text
'Check for existing comment in Destination cell
Set cmt = shtDest.Cells(lCurRow, 2).Comment

If (cmt Is Nothing) Then 'If no comment add one
Set cmt = shtDest.Cells(lCurRow, 2).AddComment
End If

cmt.Text Text:=zHoldCmt 'Place comment text in destination comment

End If

lHit = 0 'Reset found match status!

End If

lCurRow = lCurRow + 1 'Move to next Destination row.

'Loop until next cell is blank
'assumes there are no blank lines in your destination sheet!

Loop Until Cells(lCurRow, 2) = ""

End Sub 'CopyComments

[yujin]

Here's the modified code for step 1 and 2.

Sub SubmitSubModalityBudget()
    Dim lCurRow As Long
    Dim lHit As Long
    Dim shtSource As Worksheet
    Dim shtDest As Worksheet
    
    Set shtDest = ActiveWorkbook.Sheets("Karisma Raw Data Sheet")
    Set shtSource = ActiveWorkbook.Sheets("Revenue_Services Calculation")
    
    shtDest.Activate
    lCurRow = 4
    lHit = 0
    
    Do
        On Error Resume Next
        lHit = WorksheetFunction.Match(Cells(lCurRow, 1), _
            shtSource.Range("E19:E29"), 0)
        On Error GoTo 0
        
        If lHit > 0 Then
            shtSource.Range("F19:Q19").Offset(lHit - 1).Copy _
                Destination:=Cells(lCurRow, "F")
            lHit = 0
        End If
        lCurRow = lCurRow + 1
    Loop Until Cells(lCurRow, 1) = ""
End Sub