VBA intelligente Tabelle umbenennen

[el-rettev]

Hallo,

ich möchte eine Power Query Abfrage täglich archivieren.
Daher möchte ich die Abfrage bzw. die intelligente Tabelle mit dem Namen "Quelle" in ein neues Tabellenblatt kopieren.
Hierfür habe ich mit Hilfe von Google und dem Makro-Rekorder bereits einen VBA-Code geschrieben.
Es wird ein neues Tabellenblatt erstellt, das mit dem aktuellen Datum benannt wird. Dann werden die Daten aus der Tabelle "Quelle" in das neue Tabellenblatt kopiert.
Das klappt soweit.
Nun möchte ich aber im neuen Tabellenblatt die intelligente Tabelle automatisiert umbenennen. 
Sie soll "tbl_aktuellesDatum" benannt werden. Also für heute: tbl_17.10.2022.

Würde mich sehr freuen, wenn wir jemand unter die Arme greifen würde. 
Vielen Dank.

Gruß

Code:

Sub Daten_in_neues_Tabellenblatt_kopieren()
'Neues benanntes Tabellenblatt einfügen
'Daten in neues Tabellenblatt kopieren

'Dimensionierung der Variablen
Dim blatt As Object
Dim BlattName As String
Dim bolFlg As Boolean

'Blattname festlegen
BlattName = Format(Now, "dd.mm.yyyy")

'Prüfen, ob das Blatt, welches eingefügt werden soll bereits vorhanden ist
'Nur einfügen, wenn Blatt noch nicht vorhanden ist
For Each blatt In Sheets
  If blatt.Name = BlattName Then bolFlg = True
Next blatt

'Blatt nur einfügen, wenn noch nicht vorhanden
If bolFlg = False Then
  With ThisWorkbook
    .Sheets.Add after:=Sheets(1)
    .ActiveSheet.Name = Format(Now, "dd.mm.yyyy")
  End With
End If

'Daten in das neue Blatt übertragen
Sheets("Tabelle1").Range("Quelle[#All]").Copy
ActiveSheet.Paste


End Sub

[Kuwer]

Hallo,

Code:

Sub Daten_in_neues_Tabellenblatt_kopieren()
  'Neues benanntes Tabellenblatt einfügen
  'Daten in neues Tabellenblatt kopieren
  
  'Dimensionierung der Variablen
  Dim blatt As Object
  Dim BlattName As String
  Dim bolFlg As Boolean
  
  'Blattname festlegen
  BlattName = Format(Date, "dd.mm.yyyy")
  
  'Prüfen, ob das Blatt, welches eingefügt werden soll bereits vorhanden ist
  'Nur einfügen, wenn Blatt noch nicht vorhanden ist
  For Each blatt In ThisWorkbook.Sheets
    If blatt.Name = BlattName Then bolFlg = True
  Next blatt
  
  'Blatt nur einfügen, wenn noch nicht vorhanden
  If Not bolFlg Then
    With ThisWorkbook
      .Sheets.Add(after:=.Sheets(1)).Name = BlattName
      'Daten in das neue Blatt übertragen
      .Sheets("Tabelle1").Range("Quelle[#All]").Copy
      With .Sheets(BlattName)
        .Paste
        .ListObjects(1).Name = "tbl_" & BlattName
      End With
    End With
  End If
End Sub

Gruß Uwe

[el-rettev]

Hallo Uwe, 

funktioniert perfekt. Vielen Dank dafür!