Find and copy a specific cell in multiple sheets and paste it in master sheet

[Rafay]

Hi, I have a query
I have an excel file containing multiple sheets of sales invoices. I want to copy some information like client name, date, total, etc and paste it in master sheet. Currently I am using a macro to copy the information in same cell across all the sheets. To do this, I go to the cell that I want to copy from other sheets and run this macro:
Sub AutoFillSheetNames()
'Update by Extendoffice
Dim ActRng As Range
Dim ActWsName As String
Dim ActAddress As String
Dim Ws As Worksheet
On Error Resume Next
xTitleId = "KutoolsforExcel"
Set ActRng = Application.ActiveCell
ActWsName = Application.ActiveSheet.Name
ActAddress = ActRng.Address(False, False)
Application.ScreenUpdating = False
xIndex = 0
For Each Ws In Application.Worksheets
If Ws.Name <> ActWsName Then
ActRng.Offset(xIndex, 0).Value = "='" & Ws.Name & "'!" & ActAddress
xIndex = xIndex + 1
End If
Next
Application.ScreenUpdating = True
End Sub
The problem is that the total of invoices is not in the same cell. So I need a macro to search for "Grand Total" in each sheet and copy the cell next to it and paste it in master sheet.

 

[HaHoBe]

Hi Rafay,

maybe try

Sub MrE1221436_161380B_GTColA_Formula()
'www.mrexcel.com/board/threads/find-and-copy-a-specific-cell-in-multiple-sheets-and-paste-it-in-master-sheet.1221436/
'Grand Total is in Column A last row
  Dim wsMaster      As Worksheet
  Dim ws            As Worksheet
  
  Application.ScreenUpdating = False
  Set wsMaster = ActiveSheet
  For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> wsMaster.Name Then
      wsMaster.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
          "='" & ws.Name & "'!" & ws.Range("A" & Rows.Count).End(xlUp).Offset(0, 1).Address(0, 0)
    End If
  Next ws
  Set wsMaster = Nothing
  Application.ScreenUpdating = True
End Sub

Sub MrE1221436_161380B_GTColA_Values()
'Grand Total is in Column A last row
  Dim wsMaster      As Worksheet
  Dim ws            As Worksheet

  Application.ScreenUpdating = False
  Set wsMaster = ActiveSheet
  For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> wsMaster.Name Then
      wsMaster.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = ws.Name
      wsMaster.Range("A" & Rows.Count).End(xlUp).Offset(0, 1).Value = ws.Range("A" & Rows.Count).End(xlUp).Offset(0, 1).Address(0, 0)
      wsMaster.Range("A" & Rows.Count).End(xlUp).Offset(0, 2).Value = ws.Range("A" & Rows.Count).End(xlUp).Offset(0, 1).Value
    End If
  Next ws
  Set wsMaster = Nothing
  Application.ScreenUpdating = True
End Sub

Sub MrE1221436_161380B_GTAnywhere_Values()
'Grand Total is anywhere in the sheet
  Dim wsMaster      As Worksheet
  Dim ws            As Worksheet
  Dim rngFound      As Range
  
  Application.ScreenUpdating = False
  Set wsMaster = ActiveSheet
  For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> wsMaster.Name Then
      With ws.UsedRange
        Set rngFound = .Find("Grand Total", LookIn:=xlValues, SearchDirection:=xlPrevious)
        If Not rngFound Is Nothing Then
          wsMaster.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = ws.Name
          wsMaster.Range("A" & Rows.Count).End(xlUp).Offset(0, 1).Value = rngFound.Offset(0, 1).Address(0, 0)
          wsMaster.Range("A" & Rows.Count).End(xlUp).Offset(0, 2).Value = rngFound.Offset(0, 1).Value
        End If
      End With
    End If
  Next ws
  Set rngFound = Nothing
  Set wsMaster = Nothing
  Application.ScreenUpdating = True
End Sub

Ciao,
Holger

 

[Rafay]

Hi Rafay,

maybe try

Sub MrE1221436_161380B_GTColA_Formula()
'www.mrexcel.com/board/threads/find-and-copy-a-specific-cell-in-multiple-sheets-and-paste-it-in-master-sheet.1221436/
'Grand Total is in Column A last row
  Dim wsMaster      As Worksheet
  Dim ws            As Worksheet
 
  Application.ScreenUpdating = False
  Set wsMaster = ActiveSheet
  For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> wsMaster.Name Then
      wsMaster.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
          "='" & ws.Name & "'!" & ws.Range("A" & Rows.Count).End(xlUp).Offset(0, 1).Address(0, 0)
    End If
  Next ws
  Set wsMaster = Nothing
  Application.ScreenUpdating = True
End Sub

Sub MrE1221436_161380B_GTColA_Values()
'Grand Total is in Column A last row
  Dim wsMaster      As Worksheet
  Dim ws            As Worksheet

  Application.ScreenUpdating = False
  Set wsMaster = ActiveSheet
  For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> wsMaster.Name Then
      wsMaster.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = ws.Name
      wsMaster.Range("A" & Rows.Count).End(xlUp).Offset(0, 1).Value = ws.Range("A" & Rows.Count).End(xlUp).Offset(0, 1).Address(0, 0)
      wsMaster.Range("A" & Rows.Count).End(xlUp).Offset(0, 2).Value = ws.Range("A" & Rows.Count).End(xlUp).Offset(0, 1).Value
    End If
  Next ws
  Set wsMaster = Nothing
  Application.ScreenUpdating = True
End Sub

Sub MrE1221436_161380B_GTAnywhere_Values()
'Grand Total is anywhere in the sheet
  Dim wsMaster      As Worksheet
  Dim ws            As Worksheet
  Dim rngFound      As Range
 
  Application.ScreenUpdating = False
  Set wsMaster = ActiveSheet
  For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> wsMaster.Name Then
      With ws.UsedRange
        Set rngFound = .Find("Grand Total", LookIn:=xlValues, SearchDirection:=xlPrevious)
        If Not rngFound Is Nothing Then
          wsMaster.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = ws.Name
          wsMaster.Range("A" & Rows.Count).End(xlUp).Offset(0, 1).Value = rngFound.Offset(0, 1).Address(0, 0)
          wsMaster.Range("A" & Rows.Count).End(xlUp).Offset(0, 2).Value = rngFound.Offset(0, 1).Value
        End If
      End With
    End If
  Next ws
  Set rngFound = Nothing
  Set wsMaster = Nothing
  Application.ScreenUpdating = True
End Sub

Ciao,
Holger

Thank you very much Holger. Its working perfectly fine.

 

[HaHoBe]

Hi Rafay,

glad we could help here and thanks for the feedback.

Holger