Clever-Excel-Forum

Hallo zusammen,

ich habe ein Macro, welches mir bestimmte Zellen kopiert. Die Zeilenhöhen werden aber nicht berücksichtigt. Gibt es eine Möglichkeit, dass die Zeilenhöhe entsprechen des kopierten Sheets übernommen wird?

Hier der Code:

Code:
Sheets("Brief 1 (GME)").Cells.Delete

    'Sheets("Brief Test").Cells.clear

       'kopiert sichtbare Zellen im Sheet im Bereich G1:GJ28 und fügt sie im Worksheet (Brief GME) ein

       'wenn auf einem Niveau kein Brief vorhanden ist, geht wird es übersprungen (ohne "on Error resume next" entsteht ein Laufzeitfehler)

     On Error Resume Next

        Sheets("Brief 1 (G)").Range("G1:GJ28").SpecialCells(xlCellTypeVisible).Copy Worksheets("Brief 1 (GME)").Cells(1, 1)

        Sheets("Brief 1 (M)").Range("G1:GJ28").SpecialCells(xlCellTypeVisible).Copy Worksheets("Brief 1 (GME)").Cells(29, 1)

        Sheets("Brief 1 (E)").Range("G1:GJ28").SpecialCells(xlCellTypeVisible).Copy Worksheets("Brief 1 (GME)").Cells(57, 1)

    On Error GoTo 0

        'Seitenumbruch vor Zeilen 29 und 58

         Worksheets("Brief 1 (GME)").HPageBreaks.Add Before:=Worksheets("Brief 1 (GME)").Rows(29)

         Worksheets("Brief 1 (GME)").HPageBreaks.Add Before:=Worksheets("Brief 1 (GME)").Rows(57)

LG Tina

Hi,

pass die Zeilenhöhe im Anschluss des Kopiervorgangs immer direkt an - nach diesem Muster:

Code:
Sub til()

Rows(10).Copy Rows(2)

Rows(2).RowHeight = Rows(10).RowHeight

End Sub

Hallo

statt jede Zeile einzeln anzupassen würde ich den gesamten Bereich auf einheitliche Zeilenhöhe setzen. Sofern im Bereich Daten enthalten sind.

mfg Gast 123

Code:
Sub test()

'Zeilenhöhe nur kopueren wenn Daten vorhanden sind!

Zahl = Sheets("Brief 1 (G)").Range("G1:GJ28").SpecialCells(xlCellTypeVisible).Count

If Zahl > 0 Then Sheets("Brief 1 (G)").Rows("1:28").Copy Worksheets("Brief 1 (GME)").Rows(1)

Zahl = Sheets("Brief 1 (G)").Range("G1:GJ28").SpecialCells(xlCellTypeVisible).Count

If Zahl > 0 Then Sheets("Brief 1 (M)").Rows("1:28").Copy Worksheets("Brief 1 (GME)").Rows(29)

Zahl = Sheets("Brief 1 (G)").Range("G1:GJ28").SpecialCells(xlCellTypeVisible).Count

If Zahl > 0 Then Sheets("Brief 1 (E)").Rows("1:28").Copy Worksheets("Brief 1 (GME)").Rows(57)

'kopierte Daten wieder löschen für SpecialCells.Visible!

Worksheets("Brief 1 (GME)").Rows("1:100").ClearContents

'** Hier das normale Kopierprogramm:

End Sub

Hallo

bei der 1. Lösung hatte ich wohl einen kleinen Denkfehler. Spielt keine Rolle, dann probier es bitte mal so:
Hinweis: Der Befehl GoSub ist im Forum nicht üblich, ich verwende ihn trotzdem. Er muss aber mit EXIT SUB beendet werden!!

mfg Gast 123

Code:
Sub Zeilenhöhe()

Dim Brief As Worksheet, z As Integer, Zahl As Integer

Sheets("Brief 1 (GME)").Cells.Delete

     On Error Resume Next

        Sheets("Brief 1 (G)").Range("G1:GJ28").SpecialCells(xlCellTypeVisible).Copy Worksheets("Brief 1 (GME)").Cells(1, 1)

        Sheets("Brief 1 (M)").Range("G1:GJ28").SpecialCells(xlCellTypeVisible).Copy Worksheets("Brief 1 (GME)").Cells(29, 1)

        Sheets("Brief 1 (E)").Range("G1:GJ28").SpecialCells(xlCellTypeVisible).Copy Worksheets("Brief 1 (GME)").Cells(57, 1)

    On Error GoTo 0

        'Seitenumbruch vor Zeilen 29 und 58

         Worksheets("Brief 1 (GME)").HPageBreaks.Add Before:=Worksheets("Brief 1 (GME)").Rows(29)

         Worksheets("Brief 1 (GME)").HPageBreaks.Add Before:=Worksheets("Brief 1 (GME)").Rows(57)

'Zeilenhöhe durch Unterrprogramm einstellen

Zahl = Sheets("Brief 1 (G)").Range("G1:GJ28").SpecialCells(xlCellTypeVisible).Count

If Zahl > 0 Then Set Brief = Sheets("Brief 1 (G)"):  z = 1:  GoSub Zeilenhöhe

Zahl = Sheets("Brief 1 (M)").Range("G1:GJ28").SpecialCells(xlCellTypeVisible).Count

If Zahl > 0 Then Set Brief = Sheets("Brief 1 (M)"):  z = 29:  GoSub Zeilenhöhe

Zahl = Sheets("Brief 1 (E)").Range("G1:GJ28").SpecialCells(xlCellTypeVisible).Count

If Zahl > 0 Then Set Brief = Sheets("Brief 1 (E)"):  z = 57:  GoSub Zeilenhöhe

Exit Sub    'Makro mit EXIT SUB beenden!!

Zeilenhöhe:  'UNTERPROGRAMM FÜR ZEILENHÖHE

    For j = 1 To 29

        Worksheets("Brief 1 (GME)").Rows(z).RowHeight = Brief.Rows(j).RowHeight

        z = z + 1

    Next j

    Return

End Sub

Hallo Tina,

kopiere einfach die ganze(n) Zeile(n), denn dann wird auch das Format dieser übertragen:

Sheets("Brief 1 (G)").Range("G1:GJ28").SpecialCells(xlCellTypeVisible).EntireRow.Copy Worksheets("Brief 1 (GME)").Cells(1, 1)

Gruß Uwe

Hallo

wie amüsant, dann war meine 1. Variante alle Zeilen als Row zu kopieren doch richtig. Ich war da im Zweifel ....

mfg Gast 123

Hat leider nicht geklappt. Es ergab ein Problem mit nem HPageBrake.delete darunter.
Habs mit ner Hilfsspalte gelöst, die ich nach dem Zeilenanpassen einfach ausgeblendet.
Hab auch die anderen Sachen getestet. Aber es hat immer irgendwo gehakt. Kann auch mit Zellverbünden zu tun haben.
Ich danke euch trotzdem vielmals!!!
LG Tina

Hi,

Zitat:Kann auch mit Zellverbünden zu tun haben

100%ig.

so.egal

{Boris}

Gast 123

Kuwer

Gast 123

so.egal

{Boris}