Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
564to568
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
564to568
564to568
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Blatt kopieren

Blatt kopieren
13.02.2005 15:10:42
René
Hallo zusammen,
gibt es eine Möglichkeit, ein Blatt welches als "Vorlage" dient so zu kopieren dass auch die Seiteneinstellungen, wie z. B. A4quer, der festgelegte Druckbereich und die festgelegten Wiederholungszeilen mit kopiert werden?
Gruss
René

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Blatt kopieren
13.02.2005 15:32:15
René
Hier noch ein Nachtrag. Folgendes Makro wird gebraucht:
Cells.Select
Selection.Copy
Sheets("Druck").Select
Cells.Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Hiermit kopiert es mir wohl alles aber die Seitenausrichtung und die Wiederholungszeilen nicht! Wie kann ich das nun ändern damit das auch mit kopiert wird?
Das Sheet"Druck" wird für mehrere verschieden Abläufe gebraucht und sollte je nach Ablauf ein anderes Format annehmen.
Gruss
René
AW: Blatt kopieren
Udo
Kopier doch einfach das gesamte Blatt:
Sheets("Tabelle1").Copy After:=Sheets(2)
Udo
Anzeige
AW: Blatt kopieren
13.02.2005 15:52:09
René
Hallo Udo,
das wäre eine Variante. Aber dann muss ich jedesmal auch dieses Blatt wieder löschen und genau das wollte ich eigentlich umgehen.
Das Blatt "Druck" sollte von der Vorlage die entsprechenden Daten erhalten (inkl. Seitenausrichtung etc.)
Gibt es da keine andere Möglichkeit?
Gruss
René
AW: Blatt kopieren
Udo
Ist die einfachste Methode und verhindert zudem noch, dass sich die Datei durch die
Kopiererei aufbläht.
Udo
AW: Blatt kopieren
13.02.2005 16:42:44
René
Hallo Udo,
ist wohl die einfachste Art. Beim aufblähen dagegen hab ich keine Angst, da die Daten aus dem Blatt wieder gelöscht werden. Damit Du siehst was ich genau will füge ich den ganzen Code ein:

Sub Adr_Listen()
'LArt = "A"
LTitel = ""
' Vorlage holen
Sheets("VL").Select
Cells.Select
Selection.Copy
Sheets("Druck").Select
Cells.Select
ActiveSheet.Paste
Select Case LArt
Case "A":     ' Aktive
LTitel = "Aktivmitglieder"
Case "P":     ' Passive
LTitel = "Passivmitglieder"
Case "EM":     ' Ehrenmitglieder
LTitel = "Ehrenmitglieder"
Case "FM":     ' Freimitglieder
LTitel = "Freimitglieder"
Case "JM":     ' Jungmitglieder
LTitel = "Jungmitglieder"
Case "V":     ' Vorstand
LTitel = "Vorstand"
Case "G":     ' Gönner
LTitel = "Gönner"
Case "IN":     ' Inserent
LTitel = "Inserenten"
Case "Neu":     '
LTitel = "Neuanmeldungen"
Case "Fa":     '
LTitel = "Spezielle Adressen"
'      Case "Del":     '
'                    LTitel = "Delegierte"
Case "Del":     '
LTitel = "Ausgetretene Mitglieder"
Case Else:    Exit Sub
End Select
Range("A1").Value = LTitel
SZähler = 3
For LZähler = 2 To 201
' Datensatz holen, nach LArt
Sheets("Sta").Select
If Range("AA" & LZähler).Value = LArt Then
' DS übernehmen
Wert01 = Range("B" & LZähler).Value
Wert02 = Range("C" & LZähler).Value
Wert03 = Range("D" & LZähler).Value
Wert04 = Range("E" & LZähler).Value
Wert05 = Range("F" & LZähler).Value
Wert06 = Range("G" & LZähler).Value
Wert07 = Range("H" & LZähler).Value
Wert08 = Range("I" & LZähler).Value
Wert09 = Range("J" & LZähler).Value
Wert10 = Range("K" & LZähler).Value
Wert11 = Range("L" & LZähler).Value
Wert12 = Range("M" & LZähler).Value
Sheets("Druck").Select
Range("A" & SZähler).Value = Wert01
Range("B" & SZähler).Value = Wert02
Range("C" & SZähler).Value = Wert03
Range("D" & SZähler).Value = Wert04
Range("E" & SZähler).Value = Wert05
Range("F" & SZähler).Value = Wert06
Range("G" & SZähler).Value = Wert07
Range("H" & SZähler).Value = Wert08
Range("I" & SZähler).Value = Wert09
Range("J" & SZähler).Value = Wert10
Range("K" & SZähler).Value = Wert11
Range("L" & SZähler).Value = Wert12
' Rahmen festlegen
Range("A" & SZähler & ":L" & SZähler).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
If SZähler = 3 Then
Range("A" & SZähler - 1 & ":L" & SZähler - 1).Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End If
SZähler = SZähler + 1
End If
Next LZähler
' Einträge sortieren
Sheets("Druck").Select
Range("A3:L" & SZähler - 1).Select
Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, Key2:=Range("B3"), _
Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
' Drucken
ActiveWindow.SelectedSheets.PrintPreview
Antwort = MsgBox("Liste " & LTitel & " drucken ?", vbYesNo)
If Antwort = Yes Then
Druck_Neu
End If
Cells.Select
Selection.Clear
Range("A5").Select
Druck
End Sub


Sub Adr_Listen_VS()
'LArt = "A"
LTitel = ""
' Vorlage holen
Sheets("VL1").Select
Cells.Select
Selection.Copy
Sheets("Druck").Select
Cells.Select
ActiveSheet.Paste
Case "V":     ' Vorstand
LTitel = "Vorstand"
Case Else:    Exit Sub
End Select
Range("A1").Value = LTitel
SZähler = 3
For LZähler = 2 To 201
' Datensatz holen, nach LArt
Sheets("Sta").Select
If Range("AF" & LZähler).Value = LArt Then
' DS übernehmen
Wert01 = Range("B" & LZähler).Value
Wert02 = Range("C" & LZähler).Value
Wert03 = Range("D" & LZähler).Value
Wert04 = Range("F" & LZähler).Value
Wert05 = Range("G" & LZähler).Value
Wert06 = Range("I" & LZähler).Value
Wert07 = Range("J" & LZähler).Value
Wert08 = Range("K" & LZähler).Value
Wert09 = Range("L" & LZähler).Value
Wert10 = Range("M" & LZähler).Value
Wert11 = Range("V" & LZähler).Value
Wert12 = Range("Z" & LZähler).Value
Sheets("Druck").Select
Range("A" & SZähler).Value = Wert01
Range("B" & SZähler).Value = Wert02
Range("C" & SZähler).Value = Wert03
Range("D" & SZähler).Value = Wert04
Range("E" & SZähler).Value = Wert05
Range("F" & SZähler).Value = Wert06
Range("G" & SZähler).Value = Wert07
Range("H" & SZähler).Value = Wert08
Range("I" & SZähler).Value = Wert09
Range("J" & SZähler).Value = Wert10
Range("K" & SZähler).Value = Wert11
Range("L" & SZähler).Value = Wert12
' Rahmen festlegen
Range("A" & SZähler & ":L" & SZähler).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
If SZähler = 3 Then
Range("A" & SZähler - 1 & ":L" & SZähler - 1).Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End If
SZähler = SZähler + 1
End If
Next LZähler
' Einträge sortieren
Sheets("Druck").Select
Range("A3:L" & SZähler - 1).Select
Selection.Sort Key1:=Range("L3"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Columns("L:L").Select
Selection.Delete
' Drucken
ActiveWindow.SelectedSheets.PrintPreview
Antwort = MsgBox("Liste " & LTitel & " drucken ?", vbYesNo)
If Antwort = Yes Then
Druck_Neu
End If
Cells.Select
Selection.Clear
Range("A5").Select
Druck
End Sub

Bei den zwei Sachen brauch ich verschiedene Vorlagen und möchte nur einmal das Blatt "Drucken " gebrauchen.
Gruss
René
Anzeige
AW: Blatt kopieren
Udo
"da die Daten aus dem Blatt wieder gelöscht werden"
Das hilft nicht, die Datei bläht sich dennoch auf!
Udo
AW: Blatt kopieren
13.02.2005 16:54:57
René
Hallo Udo,
OK. Werd es halt mit kopieren machen und das Blatt nachher wieder löschen.
Besten Dank für Deine Unterstützung.
Gruss
René

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige