VBA über dynamische Tabellenblätter

[Westhofen]

Hallo liebe VBA Experten,

ich komme aktuell nicht weiter. Ich habe folgende Herausforderung:

Ich habe eine Tabelle in der beim öffnen ein bestimmter Bereich in jedem Register aktualisiert werden soll.
Den Code für die Aktualisierung habe ich. Jetzt besteht nur das Problem, dass immer wieder Registerkarten hinzukommen, da es Auswertungen nach KW sind.

Jetzt ist mein Plan, dass der Code im Vorfeld die Register zählt, und für jeden Register eine Variable anlegt, sodass ich in einer Loopschleife die Aktualisierung durchlaufen lassen kann. Dieser Code soll beim workbook open durchlaufen werden.

Ich hoffe ihr könnt mir dabei helfen?

Vielen Dank im voraus!

[elamigo]

Abhängig vom VBA code, was wäre mit einer Lösung a la:

Code:

Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        If XXXXXXXXX then
        End If
    Next ws
End Sub

[Westhofen]

Abhängig vom VBA code, was wäre mit einer Lösung a la:

Code:

Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        If XXXXXXXXX then
        End If
    Next ws
End Sub

Hi,

also mein Code der durchlaufen werden soll sieht wie folgt aus:

Dim Suchtitel As String
Suchtitel = Sheets("KW_11").Range("F1")

Sheets("KW_11").Activate
Sheets("KW_11").Range("B49", Selection.End(xlDown)).Activate
Sheets("KW_11").Range("B49:N500").Cells.Clear
Range("B49").Select


Sheets("Daten_aus_Rekl_Mng_2021").Activate
ActiveSheet.ListObjects("Rekla_2021").Range.AutoFilter Field:=3
Sheets("Daten_aus_Rekl_Mng_2021").Activate
ActiveSheet.Range("Rekla_2021").AutoFilter 3, Suchtitel

    ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
   
   
    Sheets("KW_11").Select
    Range("B49").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Sheets("Daten_aus_Rekl_Mng_2021").Activate
ActiveSheet.ListObjects("Rekla_2021").Range.AutoFilter Field:=3

Sheets("KW_11").Activate
Range("F1").Select

End Sub


Meine Datentabelle ist halt direkt die erste, die müsste übersprungen werden....
In blau müsste dann halt die variable rein, welche beim öffnen automatisch ermittelt wird.

gerne kann der Code auch optimiert werden ;) bin noch am Anfang mit VBA....



Ich habe den "löschen" Part mit deinem Code verknüpft, aber dann macht er mir nur die ersten beiden Sheets.

[schauan]

Hallöchen,

im Prinzip brauchst DU ja nur die Zahl variabel, was in der Art

Code:

Sub ...
For iCnt=1 to 53
strKW = "KW_" & iCnt 'falls KW_1
strKW = "KW_" & Format(iCnt, "00") 'falls KW_01
Suchtitel = Sheets(strKW).Range("F1")
...
Next
End Sub

Statt der festen 53 kann man natürlich auch die aktuelle KW berechnen und die Schleife dort enden lassen.
Zusätzlich kann man auch prüfen, ob es das betreffende Blatt gibt und wenn nicht, die Schleife verlassen und das Makro beenden oder wie auch immer reagieren.

[Gast 123]

Hallo

bereinigt sollte dein Code so funktipnieren.

mfg Gast 123

Code:

Sub Ausfüllen()
Dim Suchtitel As String
Suchtitel = Sheets("KW_11").Range("F1")
Sheets("KW_11").Range("B49:N500").Cells.Clear

Sheets("Daten_aus_Rekl_Mng_2021").Activate
ActiveSheet.ListObjects("Rekla_2021").Range.AutoFilter Field:=3
ActiveSheet.Range("Rekla_2021").AutoFilter 3, Suchtitel

ActiveSheet.Range(Selection, Selection.End(xlDown)).Copy
Sheets("KW_11").Range("B49").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False

ActiveSheet.ListObjects("Rekla_2021").Range.AutoFilter Field:=3

Sheets("KW_11").Activate
Range("F1").Select
End Sub

[Westhofen]

Guten Morgen Zusammen,

Danke für die Unterstützung. Die hat mich auf jeden Fall zur Lösung gebracht. Auch habe ich den Code verkürzen können, aber dann doch um 1 -2 Zeilen ergänzt, mit neuen Befehlen ;)

Für alle Interessierten und hoffentlich als Hilfestellung hier mein Code:

Private Sub aktualisieren()

    Sheets("Tabelle1").Select
    Range("D12").Select
    Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False

  Dim WsTabelle As Worksheet
  For Each WsTabelle In Sheets
    If Left(WsTabelle.Name, 2) = "KW" Then
      With WsTabelle
         
            Dim Suchtitel As String
            Suchtitel = WsTabelle.Range("F1")

            WsTabelle.Range("B49:P500").Cells.Clear

            Sheets("Tabelle1").Activate
            ActiveSheet.ListObjects("deine_dynamische_Tabelle").Range.AutoFilter Field:=14
            ActiveSheet.Range("deine_dynamische_Tabelle").AutoFilter 14, Suchtitel
   
            ActiveSheet.Range("A2:M2", Selection.End(xlDown)).Copy
            WsTabelle.Range("B49").PasteSpecial Paste:=xlPasteValues
            Application.CutCopyMode = False
           
            ActiveSheet.ListObjects("deine_dynamische_Tabelle").Range.AutoFilter Field:=14
                                       
                         
            WsTabelle.Select
            Columns("H:N").Select
            Columns("H:N").EntireColumn.AutoFit
           
            Range("B48").Select
            Range(Selection, Selection.End(xlDown)).Select
            Range(Selection, Selection.End(xlToRight)).Select
            Selection.Borders.LineStyle = xlNone
            Selection.BorderAround Weight:=xlThin
            Selection.Borders(xlInsideHorizontal).LineStyle = xlContinuous
            Selection.Borders(xlInsideVertical).LineStyle = xlContinuous
   
             
    Range("B48:N48").Borders.LineStyle = xlNone
    Range("B48:N48").BorderAround Weight:=xlThin
               
    Range("F1").Select

      End With
    End If
  Next WsTabelle
 
 
  Sheets(Sheets.Count).Activate
  Range("F1").Select
 
End Sub

Gruß Westhofen