Referencing cells from other sheets

Question

I am trying to extract data from different sheets in a summary sheet.

The referencing does not work.

Sub Summary_LPI()

  Dim wkSht As Worksheet, wsC As Worksheet, rngSearch As Range
  Dim shNCell As Range

  Set wsC = Sheets("Summary")
  Set rngSearch = wsC.Range("A2:A60")
  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("AZ56").Value = wsC.Range(shNCell.Offset(0, 6), shNCell.Offset(1, 6)).Value
     
    End If
Next wkSht

End Sub

Answer 1

Copy Data Into a Summary Worksheet

• Adjust the values in the constants section.
• The order of the columns in the Summary worksheet needs to be the same as in each individual worksheet.
• The number of columns to be pulled is defined by the last non-empty column in the first (header) row of the Summary worksheet.

Option Explicit

Sub Summary_LPI()
        
    ' s - Source, d - Destination
    
    Const sfvCol As String = "AY" ' First Value Column

    Const dName As String = "Summary"
    Const dlCol As String = "A" ' Lookup Column
    Const dfvColString As String = "F" ' First Value Column
    Const dhRow As Long = 1 ' Header Row
    
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
    
    Dim dfRow As Long: dfRow = dhRow + 1 ' First Row
    Dim dlrow As Long ' Last Row
    dlrow = dws.Cells(dws.Rows.Count, dlCol).End(xlUp).Row
    If dlrow < dfRow Then Exit Sub ' no data
    Dim dlcrg As Range ' Lookup Column Range
    Set dlcrg = dws.Range(dws.Cells(dfRow, dlCol), dws.Cells(dlrow, dlCol))
    
    Dim dfvCol As Long: dfvCol = dws.Columns(dfvColString).Column
    Dim dlvCol As Long ' Last Value Column
    dlvCol = dws.Cells(dhRow, dws.Columns.Count).End(xlToLeft).Column
    If dlvCol < dfvCol Then Exit Sub ' no data
    Dim vcCount As Long: vcCount = dlvCol - dfvCol + 1 ' Value Columns Count
  
    Application.ScreenUpdating = False
  
    Dim sws As Worksheet
    Dim svrrg As Range ' Value Row Range
    Dim svRow As Long ' Value Row
    Dim dvrrg As Range ' Value Row Range
    Dim dlCell As Range ' Lookup Cell
    
    For Each dlCell In dlcrg.Cells
        Set dvrrg = dlCell.EntireRow.Columns(dfvCol).Resize(, vcCount)
        On Error Resume Next
            Set sws = wb.Worksheets(CStr(dlCell.Value))
        On Error GoTo 0
        If sws Is Nothing Then ' worksheet doesn't exist
            dvrrg.ClearContents ' remove if you want to keep the previous
        Else ' worksheet exists
            svRow = sws.Cells(sws.Rows.Count, sfvCol).End(xlUp).Row
            Set svrrg = sws.Cells(svRow, sfvCol).Resize(, vcCount)
            dvrrg.Value = svrrg.Value
            Set sws = Nothing
        End If
    Next dlCell
  
    Application.ScreenUpdating = True
    
    MsgBox "Summary updated."

End Sub