Transfer data from master sheet using offset from reference cell - excel

Question

I am trying to transfer data from one master sheet to multiple template sheets based on cell name match with sheet name of the template sheets using a specific offset in the master sheet. However the referencing does not seem to work. In my case sheet named "Combine" is the master sheet. The offset value based on match cellname is 6 columns away from the matched cell. I am getting debugging error. Can anyone fix the problem?
Sub Button5_Click()
Dim wkSht As Worksheet, wsC As Worksheet, rngSearch As Range
Dim shNCell As Range
Set wsC = Sheets("Combine")
Set rngSearch = wsC.Range("A4:A800")
For Each wkSht In ThisWorkbook.Worksheets
'find the sheet name cell in rngSearch:
Set shNCell = rngSearch.Find(what:=wkSht.Name, LookIn:=xlValues, Lookat:=xlWhole,
MatchCase:=False)
'if found:
If Not shNCell Is Nothing Then
'copy the below built array in the necessary place
wkSht.Range("F12").Resize(19, 1).Value = wsC.Range(shNCell.Offset(0, 6)).Value
End If
Next wkSht
End Sub

Answer 1

Lookup Values (VBA)
Option Explicit
Sub Button5_Click()
Const ExceptionsList As String = "Combine" ' comma-saparated, no spaces!
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
' Reference the source column range ('srg').
Dim sws As Worksheet: Set sws = wb.Worksheets("Combine")
Dim slRow As Long: slRow = sws.Cells(sws.Rows.Count, "A").End(xlUp).Row
If slRow < 4 Then Exit Sub
Dim srg As Range
Set srg = sws.Range(sws.Cells(4, "A"), sws.Cells(slRow, "A"))
' Write the names from the list (string) to an array ('Exceptions').
Dim Exceptions() As String: Exceptions = Split(ExceptionsList, ",")
Dim sCell As Range
Dim dws As Worksheet
For Each dws In wb.Worksheets
' Check if not in list.
If IsError(Application.Match(dws.Name, Exceptions, 0)) Then
' '.Cells(.Cells.Count)' ensures the search starts with
' the first cell (irrelevant in this case but good to know).
' Think: After the last cell comes the first cell.
' Using 'xlFormulas' will allow you to find even if the cell
' is in a hidden row or column. The 'formula' and the 'value'
' are the same since 'xlWhole' is used.
' 'False' is the default value of the `MatchCase` argument.
With srg
Set sCell = .Find(What:=dws.Name, After:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, LookAt:=xlWhole)
End With
If Not sCell Is Nothing Then
dws.Range("F12").Value = sCell.EntireRow.Columns("G").Value
'or
'dws.Range("F12").Value = sCell.Offset(, 6).Value
'Else ' no cell found; do nothing
End If
'Else ' is in the exceptions list; do nothing
End If
Next dws
End Sub