Excel-VBA-Code zum Auffüllen des Übersichtsfensters mit der Formel zum Verknüpfen von Zellen

Question

Ich versuche ein Übersichtsblatt zu erstellen, in dem 46 Datenzeilen über 7 Spalten verteilt sind. Also werde ich die Daten von 46 Blättern ziehen und es wird 7 verschiedene Datenpunkte geben.

Kann ich die Offset-Funktion verwenden, um diesen Code zu vereinfachen, z.

Sub AutoFillSheetNames() 
    Dim ActRng As Range 
    Dim ActWsName As String 
    Dim ActAddress As String 
    Dim Ws As Worksheet 

    On Error Resume Next 

    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 

Ich mag die tatsächlichen Zellen verknüpfen, so dass sie automatisch und VBA benötigt wird, um aktualisieren, weil es für viele verschiedene Excel-Dateien mit unterschiedlichen tabnames erfolgen. Der hier angegebene Code funktioniert, wenn ich z. B. die Zelle F2 im Übersichtsblatt auf dem ersten Blatt mit 48 Blatt mit F2 verknüpfe und dann die Formel für die restlichen 47 Zellen korrekt in F48 eingabe. Wenn ich jedoch die Zelle H2 im Übersichtsblatt mit G7 auf dem ersten Blatt verknüpfen möchte, was soll ich im obigen Code ändern?

Answer 1

Ich kann wirklich nicht verstehen, was Sie erreichen möchten. Der folgende Code wird die 7 Zellen in der ersten Reihe (d. H. A1: G1) jedes Arbeitsblatts in dem Zusammenfassungsblatt verbinden. Es wird so viele Zeilen wie Tabellen geben. Aber ich weiß nicht, ob du das wirklich willst.

Sub AutoFillSheetNames() 
    Dim CurrWorkBK As Workbook 
    Dim CurrSheet As Worksheet 
    Dim TheOtherSheets As Worksheet 
    Dim MyRow As Long 
    Dim MyCol As Long 

    Set CurrWorkBK = ThisWorkbook 
    Set CurrSheet = CurrWorkBK.Worksheets("Summary") 

    MyRow = 1 
    For Each TheOtherSheets In CurrWorkBK.Worksheets 
     If TheOtherSheets.Name <> CurrSheet.Name Then 
      For MyCol = 1 To 7 
       CurrSheet.Cells(MyRow, MyCol).Value = "='" & TheOtherSheets.Name & "'!" & TheOtherSheets.Cells(1, MyCol).Address 
      Next MyCol 
      MyRow = MyRow + 1 
     End If 
    Next 
End Sub