Gruppen

Top Gruppen: Windows 7; Windows Vista; Windows XP; Textverarbeitung; Excel; DSL; Internet Browser; E-Mail/Outlook
Betriebsysteme: Windows classik; Linux; BS-Sonstige
Software: Datenbanken; Bildbearbeitung; Audio/mp3/Video; Security/Viren; SW-Sonstige
Hardware: Mainboard/CPU; Grafikkarten; Peripherie; Laptop/Notebook; HW-Sonstiges
Netzwerk: Telefon,ISDN,Modem; W-Lan; NW-Sonstiges
Programmierung: PHP,ASP,Perl...; Java,C++...; Webseiten/HTML
Sonstiges: PC-Sonstiges; Plauderecke; SN Intern; Test

/ Forum / Tabellenkalkulation

Tabellenkalkulation

Fragevon kalle3 vom 18.04.2022, 19:39 Options

Excel Makro Formatierung mit kopieren

Hallo VBA Begeisterte:

ich habe folgendes funktionierendes Makro und möchte auch die Formatierung der Spaltenbreite, Zeilenhöhe mit kopieren.

Sub Erst_Bereich_markieren_dann_kopieren_dann_Kopfzeilen_einfügen()

Dim wksSource, wksDestination As Worksheet
'Quelldatenblatt festlegen
Set wksSource = ThisWorkbook.ActiveSheet
'Markierung kopieren
Selection.Copy
'Zieldatenblatt einfügen und festlegen
Set wksDestination = ThisWorkbook.Worksheets.Add(after:=Sheets(Sheets.Count))
'Einfügen
With wksDestination
.Paste
End With
'Kopfbereich auf Quelldatenblatt kopieren
With wksSource
Range(.Cells(1, 1), .Cells(7, 16)).Copy
End With
'Kopfbereich auf Zieldatenblatt einfügen und Zeilen nach unten verschieben
With wksDestination
.Cells(1, 1).Insert Shift:=xlShiftDown
End With

'Zwischenablage löschen
Application.CutCopyMode = False

End Sub

Ablauf: ich habe ein Tabellenblatt, in der markiere ich einige Zeilen. Der Tabellenkopf wird immer mit den markierten Bereich in ein neues Tabellenblatt kopiert. Funktioniert, aber Formatierung nicht.

Formatierung kopieren mit:

With wksDestination
'PasteSpecial Paste:=xlFormats
'End With
Beim einfügen in den Code in diese Arbeitsmappe und ausführen des Makros bekomme ich bei PasteSpecial Fehlermeldung.

Bin halt nur Anfänger.
Für Hilfe bin ich dankbar!

Kalle

Antwort schreiben

Antwort 1 von Hajo_Zi vom 18.04.2022, 19:46 Options

Hallo kalle,

die Spaltenbreite kann nur übernommen werden beim kopieren der gesamten Spalte, Zeile analog. Oder Du liest Sie aus und stellst Sie nachträglich per Code ein.

Gruß Hajo

Antwort 2 von Kalle3 vom 19.04.2022, 20:50 Options

Hallo Hajo zi,

ich müsste den Formatierungscode in obiges Makro
Sub Erst_Bereich_markieren dann.....
unterbringen.
Nun habe ich für die "Formatierung übertragen" folgenden Code aufgenommen.

Sub Formatierung_übertragen()

Columns("A:P").Select
Selection.Copy
Sheets("Tabelle2").Select
Columns("A:P").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("Muster").Select
Range("A1").Select
End Sub

Die Formatierung für die Spalten wird übertragen.
Aber:
1. nur die Formatierung für die Spalten.
2. keine Zeilen werden formatiert.
3. Problem: Anzahl der Zeilen sind unterschiedlich
4. Formatierungscode in Makro "Erst_Bereich_markieren....
Später wird der Name des angelegten Tabellenblatts selbständig benannt, dadurch müsste ich obiges Makro ständig ändern.

Für mich noch nicht zu knacken.
Für Hilfe bin ich dankbar.

Grüße Kalle3

Antwort 3 von Hajo_Zi vom 19.04.2022, 21:03 Options

Hallo Kalle,


Option Explicit

Sub Formatierung_übertragen()
    Cells.Copy
    Sheets("Tabelle2").Cells.PasteSpecial Paste:=xlPasteFormats
    Application.CutCopyMode = False
End Sub

Gruß Hajo

Antwort 4 von Kalle3 vom 20.04.2022, 20:22 Options

Vielen Dank Hajo zi,

Ihr Makro funktioniert einwandfrei.
Nur führe ich mein Makro bis zu 10 Mal aus und dann kann ich Ihr Makro nur 1 Mal anwenden, den alle anderen erzeugten Tabellenblätter haben eine andere Bezeichnung.
Nun habe ich Ihr Makro in meines eingearbeitet, es läuft nur die Formatierung wird nicht übertragen.
Ob Sie mir hier noch helfen könnten?

Auf jeden Fall vielen Dank .

Kalle

Sub Erst_Bereich_markieren_dann_kopieren_dann_Kopfzeilen_einfügen()

Dim wksSource, wksDestination As Worksheet
'Quelldatenblatt festlegen
Set wksSource = ThisWorkbook.ActiveSheet
'Markierung kopieren
Selection.Copy
'Zieldatenblatt einfügen und festlegen
Set wksDestination = ThisWorkbook.Worksheets.Add(after:=Sheets(Sheets.Count))
'Einfügen
With wksDestination
.Paste
End With
'Kopfbereich auf Quelldatenblatt kopieren
With wksSource
Range(.Cells(1, 1), .Cells(7, 16)).Copy
End With
'Kopfbereich auf Zieldatenblatt einfügen und Zeilen nach unten verschieben
With wksDestination
.Cells(1, 1).Insert Shift:=xlShiftDown
End With

''wechseln auf Tabellenblatt Source
With wksSource
Cells.Copy
With wksDestination
.Cells.PasteSpecial Paste:=xlPasteFormats
End With

'Zwischenablage löschen
Application.CutCopyMode = False

End With

End Sub

Antwort 5 von Hajo_Zi vom 20.04.2022, 20:38 Options

Hallo Kalle,

beachte meinen Kommentar, ich vermute so.
Man kann im Forum auch mit Schalter arbeiten, dann ist der Code leichter lesbar.


Option Explicit

Sub Erst_Bereich_markieren_dann_kopieren_dann_Kopfzeilen_einfügen()
    Dim wksSource, wksDestination As Worksheet
    'Quelldatenblatt festlegen
    Set wksSource = ThisWorkbook.ActiveSheet
    'Markierung kopieren
    Selection.Copy
    'Zieldatenblatt einfügen und festlegen
    Set wksDestination = ThisWorkbook.Worksheets.Add(after:=Sheets(Sheets.Count))
    'Einfügen  Wohin  ??? A1 angenommen
    wksDestination.Range("A1").Paste
    'Kopfbereich auf Quelldatenblatt kopieren
    With wksSource
        Range(.Cells(1, 1), .Cells(7, 16)).Copy
    End With
    'Kopfbereich auf Zieldatenblatt einfügen und Zeilen nach unten verschieben
    wksDestination.Cells(1, 1).Insert Shift:=xlShiftDown
    ''wechseln auf Tabellenblatt Source
    With wksSource
        .Cells.Copy
        wksDestination.Cells.PasteSpecial Paste:=xlPasteFormats
        'Zwischenablage löschen
        Application.CutCopyMode = False
    End With
End Sub

Gruß Hajo

Antwort 6 von malSchauen vom 20.04.2022, 22:41 Options

Hi,

Ich habe auch mal ein wenig gespielt. Da der "Kopfbereich" ja scheinbar FIX ist habe ich diesen mal zuerst kopiert. Durch PasteSpecial dann Werte/Zellformate, Formatierungen und Spaltenbreiten einzeln im Ziel eingefügt. Nur die Zeilenhöhe lässt sich so wohl nicht übertragen. (Daher der Umweg über ein kleines Array.)

Das selbe Verfahren dann noch einmal mit der ursprünglichen Markierung.

Angenommen die zu kopierende Markierung enthält nicht die gleichen Spalten wie der bereits kopierte "Kopfbereich": Dann düfte in dieser Version die Spaltenbreite evtl. nicht passen. Je nachdem ob der Kopfbereich oder die Markierung die Spaltenbreite im Ziel bestimmen soll, wäre im (nichtbestimmenden) Bereich die Zeile .PasteSpecial Paste:=xlPasteColumnWidths auszumommentieren.

Sub Erst_Bereich_markieren_dann_Kopfzeilen_einfügen_dann_Bereich_kopieren()

Dim wksSource As Worksheet
Dim wksDestination As Worksheet
Dim rngToCopy As Range
Dim dblRHArr() As Double
Dim lngCount As Long

Application.ScreenUpdating = False                      'Bildschirmaktualisierung aus

'Quelldatenblatt festlegen
Set wksSource = ThisWorkbook.ActiveSheet
'Markierung merken
Set rngToCopy = Selection
'Zieldatenblatt einfügen und festlegen
Set wksDestination = ThisWorkbook.Worksheets.Add(after:=Sheets(Sheets.Count))

'Kopfbereich auf Quelldatenblatt kopieren
With wksSource.Range(wksSource.Cells(1, 1), wksSource.Cells(7, 16))
    .Copy
    'zeilenweise Zeilenhöhe auslesen & in Array speichern
    For lngCount = 1 To .Rows.Count Step 1
        ReDim Preserve dblRHArr(lngCount - 1)
        dblRHArr(lngCount - 1) = .Rows(lngCount).RowHeight
    Next
End With

'Kopfbereich in Ziel einfügen
With wksDestination.Cells(1, 1)
    .PasteSpecial Paste:=xlPasteValuesAndNumberFormats  'Werte und Zellformate einfügen
    .PasteSpecial Paste:=xlPasteFormats                 'Formatierungen einfügen
    .PasteSpecial Paste:=xlPasteColumnWidths            'Spaltenbreiten einfügen
    'zeilenweise Zeilenhöhe aus Array in Ziel einstellen
    For lngCount = LBound(dblRHArr) To UBound(dblRHArr) Step 1
        .Offset(lngCount, 0).EntireRow.RowHeight = dblRHArr(lngCount)
    Next lngCount
End With

'(Quell-) Markierung kopieren
ReDim dblRHArr(0)   'ZeilenhöhenArray leeren
With rngToCopy
    .Copy
    For lngCount = 1 To .Rows.Count Step 1
        ReDim Preserve dblRHArr(lngCount - 1)
        dblRHArr(lngCount - 1) = .Rows(lngCount).RowHeight
    Next
End With

'Einfügen
With wksDestination.Cells(8, 1)
    .PasteSpecial Paste:=xlPasteValuesAndNumberFormats  'Werte und Zellformate einfügen
    .PasteSpecial Paste:=xlPasteFormats                 'Formatierungen einfügen
    .PasteSpecial Paste:=xlPasteColumnWidths            'Spaltenbreiten einfügen
    .Select                                             'Select um Bereichsmarkierung aufzuheben
    'zeilenweise Zeilenhöhe aus Array in Ziel einstellen
    For lngCount = LBound(dblRHArr) To UBound(dblRHArr) Step 1
        .Offset(lngCount, 0).EntireRow.RowHeight = dblRHArr(lngCount)
    Next lngCount
End With


'Zwischenablage löschen
Application.CutCopyMode = False
Application.ScreenUpdating = True                       'Bildschirmaktualisierung ein

Set wksSource = Nothing
Set wksDestination = Nothing
Set rngToCopy = Nothing
End Sub

bye
malSchauen

Antwort 7 von Kalle3 vom 23.04.2022, 13:42 Options

Hallo "mal schauen":

ich bin hier wohl auf einen Meister VBA Programmierer gestoßen.
Das Makro funktioniert einwandfrei.
Es schleudert mich zwar beim lesen des Codes, aber das Makro funktioniert einwandfrei.
Dies erspart mir viel Zeit und Mühe.

Kann nur sagen: Danke für die Mühe Ihrerseits.

Wünsche Ihnen ein schönes Wochenende.

PS.: Kaffee gibt´s bei mir immer...

Antwort 8 von Kalle3 vom 23.04.2022, 14:00 Options

Hallo Hajo Zi,

Makro funktioniert. Ich muss Ihr Makro in das Tabellenblatt dieser Arbeitsmappe kopieren.

Das mit dem Schalter untersuche ich am Wochenende, auch was Option Explicit bedeutet muss ich noch forschen. Beim einfügen des Makros in das Modul wird immer automatisch nach Option Explicit eine waagerechte Linie eingefügt bevor der Rest des Codes aufgelistet wird.??

Auf jeden Fall das Makro läuft nun auch mit Formatierung.

Vielen Dank und ein schönes Wochenende.

Grüße Kalle

PS: Kaffee gibts bei mir immer!!!

Antwort 9 von Hajo_Zi vom 23.04.2022, 14:14 Options

Hallo Kalle,

Option Explicit bedeutet das Variablen vor der ersten Verwendung definiert werden müssen. Die meisten Leute die programmieren benutzen diese Einstellung.

Gruß Hajo

Hinweis

Diese Frage ist schon etwas älter, Sie können daher nicht mehr auf sie antworten. Sollte Ihre Frage noch nicht gelöst sein, stellen Sie einfach eine neue Frage im Forum..