Zellenformat beim kopieren komplett mitnehmen

[hziemer]

Hallo an alle hier im Forum.

Ich versuche die komplette Formatierung meines Blattes in eine neue Datei zu kopieren.

Hiermit arbeite ich.

Sub Speichern_mit_DatumV1()

Dim wkbName As String, wkbNeu As String, wksName As String

wkbName = ThisWorkbook.Name
wksName = ActiveSheet.Name
Workbooks.Add
wkbNeu = ActiveWorkbook.Name

Workbooks(wkbName).Sheets(wksName).Range("A1:h6").Copy Workbooks(wkbNeu).Sheets(1).Range("A1")
Workbooks(wkbName).Sheets(wksName).Range("A7:Z8000").Copy Workbooks(wkbNeu).Sheets(1).Range("A7")


Dim pfad As String, dateiname As String
pfad = "C:\Users\xxxxxxxx\Documents\Kunden\kkkkkk\"
dateiname = "Auswertung Heatmap täglich vom " & Range("ad7") & ".xlsx"
strDname = pfad & dateiname

With Application
 
      .ScreenUpdating = False
      .DisplayAlerts = False
  End With
      ActiveWorkbook.SaveAs strDname, FileFormat:=xlOpenXMLWorkbook
ActiveWorkbook.Close

End Sub



Das funktioniert insoweit, aber die Spaltenbreite, Zeilenhöhe, Filter in Zeile 7 und die dort vergebene Farbe wird nicht mit kopiert.

Ich habe schon das alles in der Makroaufzeichnung durchgespielt, aber ich kann den Code nicht in das obige Konstrukt einbauen.

Hier ist der Code vom Makrorekorder.

Makro2 Makro

'    Range("A7:Z7").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 5296274
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("C7:Z8000").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Rows("1:6").Select
    Selection.RowHeight = 19
    Range("A7:Z7").Select
    Selection.AutoFilter
    Range("K4").Select
End Sub

Kann mir dabei jemand helfen?

Vielen Dank an alle aus dem trüben und stürmischen Schwabenland.

Gruß
hziemer

[Flotter Feger]

Hallo,

warum kopierst du nicht das Tabellenblatt ? Da sollte alles dabei sein ... inklusive deiner bedingten Formatierung für deine Farben.

[hziemer]

Hallo Sabina

In dem Tabellenblatt gibt es noch jede Menge Informationen, die nicht mit genommen werden sollen.
Deshalb kopiere ich nur bestimmte Tabellenbereiche in die neue Datei.
Gibt es vielleicht eine Möglichkeit direkt ein Makro mit in die Ausgabe Datei zu transferieren?

Danke für eine Antwort

[Flotter Feger]

Hallo,

... Makro mitnehmen ?

JA ... kopiere das Tabellenblatt ...

[hziemer]

Wenn das so einfach wäre.

Ich habe jede Menge Code in dem Blatt, aber da wird nichts mit kopiert. Zielformat ist natürlich 'xlsm'

Was mache ich denn da falsch??

[Flotter Feger]

Ich habe keine Lust, weiter zu Raten !

Lade eine Musterdatei hoch, dann schau sich das sicher jemand an.

Deine Geheimen Codes kannst du kürzen, es reichen Code-Rümpfe wie ...
Sub XY()
MsgBox "PIEP !"
End Sub
... aber die müssen genau da sein, wo der Code normalerweise auch steht.