28.02.2022, 09:03
Seiten: 1 2
28.02.2022, 10:58
Hi
Das es geht ist dir wahrscheinlich bewusst, nur nicht wie.
Und wir müssten wenigstens wissen wie es am Ende aussehen soll. Nur von bestimmten Blättern? Alle Spalten dann nebeneinander oder untereinander oder ???
Gruß Elex
Das es geht ist dir wahrscheinlich bewusst, nur nicht wie.
Und wir müssten wenigstens wissen wie es am Ende aussehen soll. Nur von bestimmten Blättern? Alle Spalten dann nebeneinander oder untereinander oder ???
Gruß Elex
28.02.2022, 12:58
Hi,
ich hab jetzt probeweise nen Code erstellt, der teilweise für ein Sheet funktioniert. Er übernimmt aber nicht die Formatierung. Ich habe dummerweise verbundene Zellen in den Sheets und befürchte, das könnte ein Problem werden.
Es handelt sich In "Brief 1" um Seiten, die nebeneinander angeordnet sind. In "Brief Test" sollen die sichtbaren Seiten reinkopiert werden.
Jetzt sollen aus einem weiteren Sheet "Brief 2" die sichtbaren Seiten unter denen des ersten Sheets "Brief 1", kopiert werden. Und dann noch aus einem dritten Sheet "Brief 3", wieder darunter.
Könnte ich vielleicht so vorgehen:
Aber dann bräuchte ich noch etwas im Code, was mir einen "Seitenumbruch" bei Zeile 29 und Zeile 58 setzt.
LG Tina
ich hab jetzt probeweise nen Code erstellt, der teilweise für ein Sheet funktioniert. Er übernimmt aber nicht die Formatierung. Ich habe dummerweise verbundene Zellen in den Sheets und befürchte, das könnte ein Problem werden.
Es handelt sich In "Brief 1" um Seiten, die nebeneinander angeordnet sind. In "Brief Test" sollen die sichtbaren Seiten reinkopiert werden.
Jetzt sollen aus einem weiteren Sheet "Brief 2" die sichtbaren Seiten unter denen des ersten Sheets "Brief 1", kopiert werden. Und dann noch aus einem dritten Sheet "Brief 3", wieder darunter.
Könnte ich vielleicht so vorgehen:
Code:
Sub Copy()
Worksheets("Brief 1").Unprotect
Worksheets("Brief 2").Unprotect
Worksheets("Brief 3").Unprotect
Sheets("Brief 1").Range("G1:GJ28").SpecialCells(xlCellTypeVisible).Copy
Worksheets("Brief Test").Range("A1").PasteSpecial
Sheets("Brief 2").Range("G1:GJ28").SpecialCells(xlCellTypeVisible).Copy
Worksheets("Brief Test").Range("A29").PasteSpecial
Sheets("Brief 3").Range("G1:GJ28").SpecialCells(xlCellTypeVisible).Copy
Worksheets("Brief Test").Range("A58").PasteSpecial
Worksheets("Brief 1").Protect
Worksheets("Brief 2").Protect
Worksheets("Brief 3").Protect
End Sub
Aber dann bräuchte ich noch etwas im Code, was mir einen "Seitenumbruch" bei Zeile 29 und Zeile 58 setzt.
LG Tina
28.02.2022, 13:16
So ähnlich hätte ich es dir auch vorgeschlagen.
Was die Ausrichtung des Druckbereiches angeht. Kopiere doch einfach in die erste Zeile der neuen Seite.
Das alles klappt aber eh nur bei gleichen Spaltenbreiten.
Gruß Elex
Code:
Sub Copy()
Sheets("Brief Test").Cells.Clear
Sheets("Brief 1").Range("G1:GJ28").SpecialCells(xlCellTypeVisible).Copy Sheets("Brief Test").Range("A1")
Sheets("Brief 2").Range("G1:GJ28").SpecialCells(xlCellTypeVisible).Copy Sheets("Brief Test").Range("A51") 'Range("A51") anpassen
Sheets("Brief 3").Range("G1:GJ28").SpecialCells(xlCellTypeVisible).Copy Sheets("Brief Test").Range("A101")
End Sub
Was die Ausrichtung des Druckbereiches angeht. Kopiere doch einfach in die erste Zeile der neuen Seite.
Das alles klappt aber eh nur bei gleichen Spaltenbreiten.
Gruß Elex
28.02.2022, 13:32
Hallo Elex,
Du machst mich neugierig, wie das gehen würde?
Gruß Uwe
(28.02.2022, 13:16)Elex schrieb: [ -> ]Was die Ausrichtung des Druckbereiches angeht. Kopiere doch einfach in die erste Zeile der neuen Seite.
Du machst mich neugierig, wie das gehen würde?
Gruß Uwe
28.02.2022, 13:44
Ich schau da einfach mal ins Seitenlayout. Kann aber auch sein das wir das eigentliche Problem anders Raten.
28.02.2022, 13:45
Hallo Tina,
Gruß Uwe
(28.02.2022, 12:58)so.egal schrieb: [ -> ]Aber dann bräuchte ich noch etwas im Code, was mir einen "Seitenumbruch" bei Zeile 29 und Zeile 58 setzt.
Code:
Worksheets("Brief Test").HPageBreaks.Add Before:=Worksheets("Brief Test").Rows(29)
Worksheets("Brief Test").HPageBreaks.Add Before:=Worksheets("Brief Test").Rows(58)
Gruß Uwe
01.03.2022, 08:00
Hi nochmal,
jetzt ist ein weiteres Problem aufgetaucht.
In den Zellen die kopiert werden sollen stehen Verknüpfungen, die genau so übernommen werden sollen. Die Verknüpfungen ändern sich aber. So wird aus ='KN 1-Sch'!S7 beispielsweise ='KN 1-Sch'!M7. Kann ich das irgendwie vermeiden?
Hier mein aktueller Code:
LG Tina
jetzt ist ein weiteres Problem aufgetaucht.
In den Zellen die kopiert werden sollen stehen Verknüpfungen, die genau so übernommen werden sollen. Die Verknüpfungen ändern sich aber. So wird aus ='KN 1-Sch'!S7 beispielsweise ='KN 1-Sch'!M7. Kann ich das irgendwie vermeiden?
Hier mein aktueller Code:
Code:
Sub Copy()
Worksheets("Brief 1").Unprotect
Worksheets("Brief 2").Unprotect
Worksheets("Brief 3").Unprotect
'kopiert sichtbare Zellen im Sheet im Bereich G1:GJ28 und fügt sie im Worksheet in A1 ein
Sheets("Brief 1").Range("G1:GJ28").SpecialCells(xlCellTypeVisible).Copy
Worksheets("Brief Test").Range("A1").PasteSpecial
Sheets("Brief 2").Range("G1:GJ28").SpecialCells(xlCellTypeVisible).Copy
Worksheets("Brief Test").Range("A29").PasteSpecial
Sheets("Brief 3").Range("G1:GJ28").SpecialCells(xlCellTypeVisible).Copy
Worksheets("Brief Test").Range("A58").PasteSpecial
'Seitenumbruch vor Zeilen 29 und 58
Worksheets("Brief Test").HPageBreaks.Add Before:=Worksheets("Brief Test").Rows(29)
Worksheets("Brief Test").HPageBreaks.Add Before:=Worksheets("Brief Test").Rows(58)
'Seitenumbruch vor Spalte G
Worksheets("Brief Test").Columns("G").PageBreak = xlPageBreakManual
'Seitenumbruch vor Spalte entfernen
Worksheets("Brief 1").Protect
Worksheets("Brief 2").Protect
Worksheets("Brief 3").Protect
End Sub
LG Tina
01.03.2022, 10:31
Hallo Tina,
teste mal damit:
Noch ein Hinweis: Ein Makro Copy zu nennen, ist keine gute Idee, da es den Befehl schon gibt!
Gruß Uwe
teste mal damit:
Code:
Sub CopyMacro()
Dim varQ As Variant
Worksheets("Brief 1").Unprotect
Worksheets("Brief 2").Unprotect
Worksheets("Brief 3").Unprotect
'kopiert sichtbare Zellen im Sheet im Bereich G1:GJ28 und fügt sie im Worksheet in A1 ein
Sheets("Brief 1").Range("G1:GJ28").SpecialCells(xlCellTypeVisible).Copy
varQ = Sheets("Brief 1").Range("G1:GJ28").SpecialCells(xlCellTypeVisible).Formula
Worksheets("Brief Test").Range("A1").PasteSpecial
Worksheets("Brief Test").Range("A1").Resize(UBound(varQ, 1), UBound(varQ, 2)).Formula = varQ
Sheets("Brief 2").Range("G1:GJ28").SpecialCells(xlCellTypeVisible).Copy
varQ = Sheets("Brief 2").Range("G1:GJ28").SpecialCells(xlCellTypeVisible).Formula
Worksheets("Brief Test").Range("A29").PasteSpecial
Worksheets("Brief Test").Range("A29").Resize(UBound(varQ, 1), UBound(varQ, 2)).Formula = varQ
Sheets("Brief 3").Range("G1:GJ28").SpecialCells(xlCellTypeVisible).Copy
varQ = Sheets("Brief 3").Range("G1:GJ28").SpecialCells(xlCellTypeVisible).Formula
Worksheets("Brief Test").Range("A58").PasteSpecial
Worksheets("Brief Test").Range("A58").Resize(UBound(varQ, 1), UBound(varQ, 2)).Formula = varQ
'Seitenumbruch vor Zeilen 29 und 58
Worksheets("Brief Test").HPageBreaks.Add Before:=Worksheets("Brief Test").Rows(29)
Worksheets("Brief Test").HPageBreaks.Add Before:=Worksheets("Brief Test").Rows(58)
'Seitenumbruch vor Spalte G
Worksheets("Brief Test").Columns("G").PageBreak = xlPageBreakManual
'Seitenumbruch vor Spalte entfernen
Worksheets("Brief 1").Protect
Worksheets("Brief 2").Protect
Worksheets("Brief 3").Protect
End Sub
Noch ein Hinweis: Ein Makro Copy zu nennen, ist keine gute Idee, da es den Befehl schon gibt!
Gruß Uwe
01.03.2022, 13:32
Hallo,
hier noch eine komprimierte Variante über eine Schleife:
Gruß Uwe
hier noch eine komprimierte Variante über eine Schleife:
Code:
Sub CopyMacro2()
Dim i As Long
Dim rngF As Range
Dim strZ() As String
Dim varQ As Variant
strZ = Split(",1,29,58", ",") 'Seitenanfangszeilen
For i = 1 To UBound(strZ)
With Sheets("Brief " & i).Range("G1:GJ28")
.Parent.Unprotect
varQ = .Formula
For Each rngF In .SpecialCells(xlCellTypeFormulas)
rngF.Formula = Application.ConvertFormula(rngF.Formula, xlA1, , xlAbsolute)
Next rngF
'kopiert sichtbare Zellen im Sheet im Bereich G1:GJ28 und fügt sie im Worksheet ein
.SpecialCells(xlCellTypeVisible).Copy Worksheets("Brief Test").Cells(strZ(i), 1)
.Formula = varQ
.Parent.Protect
End With
Next i
With Worksheets("Brief Test")
.ResetAllPageBreaks
'Seitenumbruch vor den im Array strZ hinterlegten Zeilen
For i = 2 To UBound(strZ)
.HPageBreaks.Add Before:=Worksheets("Brief Test").Rows(strZ(i))
Next i
'Seitenumbruch vor Spalte G
.VPageBreaks.Add Before:=Tabelle3.Columns(7)
End With
End Sub
Gruß Uwe
Seiten: 1 2