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

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

CodePudding user response：

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

CodePudding user response：

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 = shNCell.Offset(0, 6).value
    End If
   Next wkSht
  End Sub