Ссылка на одну ячейку в разных листах и ​​книгах

Question

Мне нужно создать таблицу со ссылками на одну и ту же ячейку в разных листах и ​​книгах. В следующей ссылке вы можете найти то, что я имею в виду, но это работает только для разных листов в одной книге (той, что содержит макрос). Я хотел бы распространить его на другие 2 или более рабочих книг (одну и ту же ячейку на каждом листе каждой рабочей книги в указанном каталоге windows).

Go до кода vba на этой странице (эта версия кода больше, чем мне нужно, после того, как вы увидите более легкий код, который я изменил) https://www.extendoffice.com/documents/excel/1337-excel-reference-same-cell-different-sheet.html

Public Sub abc()
    Dim Wbook           As Workbook
    Dim WSheet          As Worksheet

Dim FSO             As Object
Dim ExcelFile       As Object
Dim MyFolder        As Object

Dim MyFolderPath    As String
Dim CurrSheet       As String
Dim a               As Long

' Define the path of your folder here
MyFolderPath = "C:\Users\username\Desktop\Cartella\"

Set FSO = CreateObject("Scripting.FileSystemObject")

' Stop the macro if the folder is not found
If Not FSO.FolderExists(MyFolderPath) Then
    MsgBox "Cannot find the specified folder!", vbOKOnly + vbCritical, "Error"
    Exit Sub
End If

Set MyFolder = FSO.GetFolder(MyFolderPath)
CurrSheet = ThisWorkbook.ActiveSheet.Name
Application.ScreenUpdating = False

' Loop through all files from the folder selected
For Each ExcelFile In MyFolder.Files

    ' Make sure we check only Excel files
    If Left(FSO.GetExtensionName(ExcelFile.Path), 2) = "xl" Then
        a = 0

        ' Open the workbook (except the workbook that runs the code)
        If ExcelFile.Name <> ThisWorkbook.Name And Left(ExcelFile.Name, 2) <> "~$" Then
            Set Wbook = Workbooks.Open(MyFolderPath & ExcelFile.Name)
        Else
            Set Wbook = ThisWorkbook
        End If

        ' Loop through workbook's sheets
        For Each WSheet In Wbook.Worksheets

            If WSheet.Name <> CurrSheet Then
                    'In the masterFile I have a table (inside "Resume" sheet) with: first column Sheet names of all sheets in all workbooks
                    'Second column: a reference formula of each Q32 cells in all worksheets of all workbooks

                    'The next 2 lines are not working (also because I dont know the correct syntax) but It's only to explain what I mean
                    Workbooks("MasterFile").Worksheets("Resume").Range("A4").Offset(a, 0).Value = WSheet.Name
                    Workbooks("MasterFile").Worksheets("Resume").Range("B4").Offset(a, 0).Value = "=[Wbook.Name]WSheet.Name!Q32"

                a = a + 1
            End If
        Next WSheet

        ' Close and save the workbooks (only save the workbook that runs the code)
        If ExcelFile.Name <> ThisWorkbook.Name And Left(ExcelFile.Name, 2) <> "~$" Then
            Wbook.Close SaveChanges:=True
        Else
            Wbook.Save
        End If

        Set Wbook = Nothing
    End If
Next ExcelFile

Application.ScreenUpdating = True

End Sub

Answer 1

FileSystemObject отлично подходит для этой работы, см. Код ниже. Это должно l oop через каждый файл Excel в папке, выбранной в переменной «MyFolderPath».

Теперь, если вы хотите включить книгу, в которой выполняется код, вы также должны поместить ее в эту папку.

Еще одна вещь, которую я заметил в вашем текущем коде (и я так и есть) у вас есть условие не писать в листы с тем же именем, что и лист, из которого вы запускаете макрос (это активный лист).

Если вы собираетесь сохранить это, убедитесь, что ваши листы из других рабочих книг не имеют общего названия, иначе они будут пропущены.

РЕДАКТИРОВАТЬ: Обновлен на основе последних данных OP

Он добавит имя мастера и ссылку на ячейку Q32 из каждой отсканированной рабочей книги, включая главную книгу (если она размещена только в папке), в мастер лист, начинающийся с 4-й строки.

Следует пропустить мастер-лист «Возобновить», но только из основной рабочей книги - если у вас есть другой лист, названный как основной, но в другой рабочей книге, это будет проверяется как любой другой лист.

Option Explicit

Public Sub LoopThroughFiles()
    Dim Wbook           As Workbook
    Dim WSheet          As Worksheet

    Dim FSO             As Object
    Dim ExcelFile       As Object
    Dim MyFolder        As Object

    Dim MyFolderPath    As String
    Dim MasterSheet     As String
    Dim IsMasterFile    As Boolean
    Dim a               As Long

    ' Define the path of your folder here
    MyFolderPath = "C:\Users\username\Desktop\Cartella\"
    MasterSheet = "Resume"

    Set FSO = CreateObject("Scripting.FileSystemObject")

    ' Stop the macro if the folder is not found
    If Not FSO.FolderExists(MyFolderPath) Then
        MsgBox "Cannot find the specified folder!", vbOKOnly + vbCritical, "Error"
        Exit Sub
    End If

    Set MyFolder = FSO.GetFolder(MyFolderPath)
    Application.ScreenUpdating = False

    ' Loop through all files from the folder selected
    For Each ExcelFile In MyFolder.Files

        ' Make sure we check only Excel files (and ignore the temp files)
        If Left(FSO.GetExtensionName(ExcelFile.Path), 2) = "xl" And Left(ExcelFile.Name, 2) <> "~$" Then

            ' Reset flag
            IsMasterFile = False

            ' Open the workbook, except the master workbook which is already opened
            If ExcelFile.Name <> ThisWorkbook.Name Then
                Set Wbook = Workbooks.Open(MyFolderPath & ExcelFile.Name)
            Else
                Set Wbook = ThisWorkbook
                IsMasterFile = True
            End If

            ' Loop through workbook's sheets
            For Each WSheet In Wbook.Worksheets

                ' Don't check the "Resume" sheet from master workbook
                If IsMasterFile And WSheet.Name = MasterSheet Then GoTo Skip

                With WSheet
                    ThisWorkbook.Worksheets(MasterSheet).Range("A4").Offset(a, 0).Value2 = .Name
                    ThisWorkbook.Worksheets(MasterSheet).Range("B4").Offset(a, 0).Value2 = "='[" & Wbook.Name & "]" & .Name & "'!" & "Q32"
                End With

                a = a + 1
Skip:
            Next WSheet

            ' Close the workbooks except the master one
            If IsMasterFile = False Then Wbook.Close SaveChanges:=False
            Set Wbook = Nothing
        End If
    Next ExcelFile

    Application.ScreenUpdating = True
End Sub