Anzeige
Archiv - Navigation
1692to1696
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
Inhaltsverzeichnis

Zellformate mitkopieren

Zellformate mitkopieren
19.05.2019 12:05:34
Anja
Hallo zusammen,
Ich möchte gerne ein Blankoblatt unter ein Datenblatt kopieren, sobald dieses mit Daten gefüllt wurde. Das funktioniert soweit. Jetzt habe ich immer wieder das Problem, dass die Zellformate nicht übernommen werden. Ich habe schon vieles versucht komme aber nicht weiter.
Wo wird der Code:
"PasteSpecial Paste:=xlPasteFormats"
eingefügt, damit die Formate des Blankoblattes übernommen werden?
With Zieltab
If j = 1 Then
.Paste Destination:=.Range("A" & j)
end if
End With
Danke Anja

16
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zellformate mitkopieren
19.05.2019 12:08:42
Hajo_Zi
Halo Anja,
.range("S:D").copy .Range("A" & j)

Beiträge von Werner, Luc, robert, J.O.Maximo und folgende lese ich nicht.
Die Beiträge werden auch ignoriert, es erfolgt keine Antwort.
AW: Zellformate mitkopieren
19.05.2019 13:09:10
Anja
Hallo Hajo,
danke für deine Antwort.
Leider komme ich immer noch nicht weiter. Ich schicke mal den ganzen Code mit, damit es deutlicher wird. Ich bin VBA-unerfahren und somit durchblicke ich leider noch nicht die Gesamtstrukturen.
Daher fällt es mir schwer einzuschätzen, wie die einzelnen Befehle in welcher Syntax anzugeben sind.
Der Code unten funktioniert, bis auf die Tatsache, dass das Format der Blankoseite nicht übernommen wird.
Vielen Dank.
Anja
Sub BlankoUrkundenJgJ_2_5kopieren()
'neue Seite ans Ende kopieren
Dim i As Integer
Dim j As Integer
Dim Quelltab As Worksheet
Dim Zieltab As Worksheet
Dim s As Integer
Dim Bereich As Range
Set Quelltab = Worksheets("Blanko-UrkundenJgJ (2-5)")
Set Zieltab = Worksheets("UrkundenJgJ (2-5)")
''Blattschutz aus
'Quelltab.Unprotect Password:="123"
i = Quelltab.Cells(Quelltab.Rows.Count, 1).End(xlUp).Row
Quelltab.Range(Quelltab.Cells(1, 1), Quelltab.Cells(i, 60)).Copy
j = Zieltab.Cells(Zieltab.Rows.Count, 1).End(xlUp).Row
With Zieltab
If j = 1 Then
.Paste Destination:=.Range("A" & j)
Range("A" & j) = "Kampfliste JgJ Nr. " & j
Else
.Paste Destination:=.Range("A" & j + 1)
Range("A" & j) = "Kampfliste JgJ Nr. " & (j) / 50
End If
End With
''Blattschutz für Blanko ein
'Quelltab.Protect Password:="123", UserInterfaceOnly:=True, DrawingObjects:=True, Contents:= _
True, Scenarios:=True
Call UrkundenJgJ_2_5
End Sub

Anzeige
AW: Zellformate mitkopieren
19.05.2019 13:15:54
Hajo_Zi

Option Explicit
Sub BlankoUrkundenJgJ_2_5kopieren()
'neue Seite ans Ende kopieren
Dim i As Integer
Dim j As Integer
Dim Quelltab As Worksheet
Dim Zieltab As Worksheet
Dim s As Integer
Dim Bereich As Range
Set Quelltab = Worksheets("Blanko-UrkundenJgJ (2-5)")
Set Zieltab = Worksheets("UrkundenJgJ (2-5)")
''Blattschutz aus
'Quelltab.Unprotect Password:="123"
With Zieltab
i = Quelltab.Cells(Quelltab.Rows.Count, 1).End(xlUp).Row
j = .Cells(.Rows.Count, 1).End(xlUp).Row
If j = 1 Then
Quelltab.Range(Quelltab.Cells(1, 1), Quelltab.Cells(i, 60)).Copy = .Range("A" & j)
Range("A" & j) = "Kampfliste JgJ Nr. " & j
Else
Quelltab.Range(Quelltab.Cells(1, 1), Quelltab.Cells(i, 60)).Copy = .Range("A" & j +  _
1)
Range("A" & j) = "Kampfliste JgJ Nr. " & (j) / 50
End If
End With
''Blattschutz für Blanko ein
'Quelltab.Protect Password:="123", UserInterfaceOnly:=True, DrawingObjects:=True, Contents:= _
_
True, Scenarios:=True
Call UrkundenJgJ_2_5
End Sub
Das Range ist ohne Punkt das soll sich also auf die Aktuelle Tabelle beziehen.
Gruß Hajo
Anzeige
AW: Zellformate mitkopieren
19.05.2019 14:06:43
Anja
Hallo Hajo,
leider funktioniert auch das nicht: Laufzeitfehlt 424, Objekt erforderlich
diese Zeile wird gelb hinterlegt:
Quelltab.Range(Quelltab.Cells(1, 1), Quelltab.Cells(i, 60)).Copy = .Range("A" & j + _
1)
Ich danke dir trotzdem...und verzweifel gerade
AW: Zellformate mitkopieren
19.05.2019 14:10:32
Werner
Hallo Anja,
warum ignorierst du Onur?
Lass mal das = weg
Quelltab.Range(Quelltab.Cells(1, 1), Quelltab.Cells(i, 60)).Copy .Range("A" & j + 1)
Gruß Werner
AW: Zellformate mitkopieren
19.05.2019 14:56:45
Anja
Hallo Werner,
danke, mit deinem Tipp wird kein Fehler mehr angezeigt, aber sonst passiert auch nichts....
Ich ignoriere keinen, schon mal gar nicht, wenn man mir helfen möchte :-)
Ich bin nur nicht so schnell und probiere ja alles Mögliche aus, um mit den Tipps der anderen weiter zu kommen.
Viele Grüße
Anja
Anzeige
AW: Zellformate mitkopieren
19.05.2019 13:17:47
onur

With Zieltab.Range("A" & j)
If j = 1 Then
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Range("A" & j) = "Kampfliste JgJ Nr. " & j
Else
End With

AW: Zellformate mitkopieren
19.05.2019 14:13:35
Anja
Hallo Onur,
danke dir. Meine Ansätze gingen auch in deine Richtung, aber es wird angezeigt:
Laufzeitfehler 1004, Die Methode PasteSpecial ist für das Objekt Worksheet fehlgeschlagen.
Woran liegt das?
Danke. Anja
Hier der Code:
Sub Blanko5()
'neue Seite ans Ende kopieren
Dim i As Integer
Dim j As Integer
Dim Quelltab As Worksheet
Dim Zieltab As Worksheet
Dim s As Integer
Dim Bereich As Range
Set Quelltab = Worksheets("Blanko-UrkundenJgJ (2-5)")
Set Zieltab = Worksheets("UrkundenJgJ (2-5)")
''Blattschutz aus
'Quelltab.Unprotect Password:="123"
i = Quelltab.Cells(Quelltab.Rows.Count, 1).End(xlUp).Row
Quelltab.Range(Quelltab.Cells(1, 1), Quelltab.Cells(i, 60)).Copy
j = Zieltab.Cells(Zieltab.Rows.Count, 1).End(xlUp).Row
With Zieltab
If j = 1 Then
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
.Paste Destination:=.Range("A" & j + 1)
Range("A" & j) = "Kampfliste JgJ Nr. " & j
Else
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
.Paste Destination:=.Range("A" & j + 1)
Range("A" & j) = "Kampfliste JgJ Nr. " & (j) / 50
End If
End With
''Blattschutz für Blanko ein
'Quelltab.Protect Password:="123", UserInterfaceOnly:=True, DrawingObjects:=True, Contents:= _
True, Scenarios:=True
Call UrkundenJgJ_2_5
End Sub

Anzeige
AW: Zellformate mitkopieren
19.05.2019 14:21:57
onur
Poste doch mal die (Beispiel)Datei.
AW: Zellformate mitkopieren
19.05.2019 14:52:51
Anja
Hallo Onur,
was meinst du mit (Beispiel) Datei? Das gesamte Programm? Das ist sehr umfangreich und ich weiß nicht, ob du dir (als Profi) das antun möchtest.... Per File-Uploader kann ich dir auch die Datei gar nicht schicken, wie ich festgestellt habe (1. zu groß, 2. falsches Format). Oder meintest du das Modul?
Danke und viele Grüße
Anja
AW: Zellformate mitkopieren
19.05.2019 14:57:05
onur
Ich brauche nur eine abgespeckte Version deiner Datei, wo dein Problem genauso auftaucht wie in der Originaldatei. Sonst müsste ich ja die beiden Blätter nachbauen, nur um alles testen zu können.
Du kannst ja z.B. alle Daten und auch die Blätter (ausser den Beiden) entfernen.
Anzeige
AW: Zellformate mitkopieren
19.05.2019 16:00:46
Anja
Hallo Onur,
ich werde jetzt noch ein paar Sachen ausprobieren. WEnn alles nicht hilft, werde ich eine abgespeckte Version erstellen. (Ist alles miteinander verknüpft, deshalb etwas aufwendig).
Ich danke dir vielmals für dein Bemühen!
Viele Grüße
Anja
AW: Zellformate mitkopieren
19.05.2019 16:02:52
onur
Du könntest sie per Dropbox posten oder per Mail schicken.
AW: Zellformate mitkopieren
19.05.2019 17:27:54
Anja
@onur: an welche Adresse?
AW: Zellformate mitkopieren
19.05.2019 17:34:26
onur
mc22@mailbox.org
Rückmeldung
19.05.2019 21:32:37
Anja
Dank Onur funktioniert folgender Code für mein Programm hervorragend, wenn man Texte, Shapes und Zeilenhöhen von einem Tabellenblatt ins andere kopieren möchte:
(Hier hatte ich v.a. Schwierigkeiten die Zeilenhöhe von dem einem Blatt ins andere zu übernehmen)
Sub BlankoUrkundenJgJ_2_5kopieren()
'neue Seite unter letzte Seite kopieren und Format übernehmen
Dim i As Integer
Dim j As Integer
Dim Quelltab As Worksheet
Dim Zieltab As Worksheet
Set Quelltab = Worksheets("Blanko-UrkundenJgJ (2-5)")
Set Zieltab = Worksheets("UrkundenJgJ (2-5)")
i = Quelltab.Cells(Quelltab.Rows.Count, 1).End(xlUp).Row
j = Zieltab.Cells(Zieltab.Rows.Count, 1).End(xlUp).Row
Quelltab.Rows("1:" & i).Copy Zieltab.Range("A" & j + 1)
If j = 1 Then
Range("A" & j) = "Kampfliste JgJ Nr. " & j
Else
Range("A" & j + 1) = "Kampfliste JgJ Nr. " & (j) / 50 + 1 ' 50 ist die Zeilenanzahl  _
meiner Seite
End If
End Sub
Vielleicht haben andere ähnliche Probleme :-)
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige