Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1848to1852
1848to1852
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Werte und Formate übertragen

Forumthread: Werte und Formate übertragen

Werte und Formate übertragen
05.10.2021 14:33:16
Eisi
Hallo zusammen,
ich übertrage gerade meine Mustertabelle auf die Originaltabelle. Das funktioniert nicht so wie ich es mir gedacht habe. Darum stoße ich laufend auf neue Probleme.
Hier bleibt der Code hängen:
'*** 2) Kopiere den gefilterten Bereich
With tbl_1_Kalkulation
Set rngBereich = .Range("F15:P43") ' Der Bereich in der Tabelle "Platten", der kopiert werden soll
rngBereich.Copy ' Kopiere den Bereich
End With
'*** 3) Letzte Zelle in Spalte 8 festlegen und Kopie 2 Zellen darunter einfügen
With tbl_2_Positionen
lastrow = .Cells(.Rows.Count, 8).End(xlUp).Row + 2 ' Letzte Zelle in Spalte 8 finden + 2 Zeilen darunter
' Ab hier kommt die Fehlermeldung !!!!!!!!!!!!!!!!!!!!!!!
.Cells(lastrow, 2).PasteSpecial Paste:=xlValues 'Fügt die kopierten Werte ein.
.Cells(lastrow, 2).PasteSpecial Paste:=xlPasteFormats 'Überträgt die Formatierung.
Application.CutCopyMode = False
End With
Ziel der Aktion:
Der Tabellenbereich soll mit Werten und Formatierung in das andere Blatt eingefügt werden.
Danke für die Hilfe.
VG Eisi :-)
Anzeige

15
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Werte und Formate übertragen
05.10.2021 14:46:37
Daniel
Hi
welche Fehlermelung genau und in welcher Zeile?
ein Fehler kann hier auch dann erfolgen, wenn du das Blatt geschützt ist und du den blattschutz nicht aufgehoben hast.
prinzipiell würde ich das so verkürzen und Variablen nur dann verwenden, wenn diese noch an anderen Stellen benötigt werden.
eben so auch die WITH-Klammer.

tbl_1_Kalkulation.Range("F15:P43").Copy
With tbl_2_Positionen.Cells(Rows.Count, 8).End(xlup).Offset(2, -6)
.PasteSpecial xlpastevalues
.PasteSpeical xlpasteformats
End With
Gruß Daniel
Anzeige
AW: Werte und Formate übertragen
05.10.2021 15:08:07
Eisi
Hallo Daniel,
danke für die Hilfe.
Genau hier stoppt der Code:
.PasteSpecial xlpastevalues
Die Blätter haben im Moment kein Blattschutz.
Soll ich mal eine Testtabelle zusammen stellen?
VG Eisi :-)
Code ist Fehlerfrei
05.10.2021 14:50:55
Klaus
Hallo Eisi,
ich habe mir eine Testmappe mit den beiden Blättern tbl_1_Kalkulation und tbl_2_Positionen erstellt und dort ein paar Rahmen, Hintergrundfarben und Zufallsformeln eingefügt. Der Code läuft bei mir Fehlerfrei durch!
Meine Vermutung: Dein lastrow läuft irgendwo in einen Fehler. Check das mal folgendermaßen durch:

Sub testsd()
'*** 2) Kopiere den gefilterten Bereich
With tbl_1_Kalkulation
Set rngBereich = .Range("F15:P43") ' Der Bereich in der Tabelle "Platten", der kopiert werden soll
rngBereich.Copy ' Kopiere den Bereich
End With
'*** 3) Letzte Zelle in Spalte 8 festlegen und Kopie 2 Zellen darunter einfügen
With tbl_2_positionen
lastrow = .Cells(.Rows.Count, 8).End(xlUp).Row + 2 ' Letzte Zelle in Spalte 8 finden + 2 Zeilen darunter
MsgBox (lastrow)
' Ab hier kommt die Fehlermeldung !!!!!!!!!!!!!!!!!!!!!!!
.Cells(lastrow, 2).PasteSpecial Paste:=xlValues 'Fügt die kopierten Werte ein.
.Cells(lastrow, 2).PasteSpecial Paste:=xlPasteFormats 'Überträgt die Formatierung.
Application.CutCopyMode = False
End With
End Sub
Ansonsten würde es wahnsinnig helfen, wenn du uns sagst WELCHE Fehlermeldung da kommt :-) oder alternativ mal wieder eine Beispielmappe hochlädst?
LG,
Klaus M.
Anzeige
AW: Code ist Fehlerfrei
05.10.2021 15:16:47
Eisi
Hi,
es kommt die Meldung MsgBox: 38
Fehlermeldung:
Laufzeitfehler 1004: Die PasteSpecial-Methode des Range-Objektes konnte nicht ausgeführt werden.
Ich stelle mal eine Testmappe zusammen.
AW: Code ist Fehlerfrei
05.10.2021 15:21:37
Eisi
Ach ja, mir fällt noch ein, dass ja der Bereich F15:P43 gefiltert ist.
Das bedeutet, in diesem Bereich sind ein paar Zeilen ausgeblendet.
Vielleicht liegt hier das Problem?
Anzeige
Mustertabelle zum Problem__AW: Code ist Fehlerfrei
05.10.2021 16:31:52
Eisi
https://www.herber.de/bbs/user/148448.xlsm
Die Fehlermeldung kommt immer noch.
VG Eisi :-)
Anzeige
Mustertabelle zum Problem__AW: Code ist Fehlerfrei
06.10.2021 02:50:36
Werner
Hallo,
es hätte jetzt durchaus Sinn gemacht in der Beispielmappe mal aufzugeigen, wie du dir das Ergebnis in deiner zweiten Tabelle vorgestellt hast. So richtig klar ist mir das nämlich nicht.
Möglicherweise meinst du so:

Option Explicit
Private Sub cmd_PlattenKopieren_Click()
Dim loLetzteQuelle As Long, loLetzteZiel As Long
Dim raBereich As Range
Application.ScreenUpdating = False
With tbl_1_Kalkulation
Set raBereich = .Range("F15:P43")
loLetzteQuelle = .Cells(.Rows.Count, "A").End(xlUp).Row
loLetzteZiel = tbl_2_Positionen.Cells(Rows.Count, "H").End(xlUp).Offset(11).Row
If tbl_2_Positionen.Cells(17, "B") = "" Then loLetzteZiel = 10
.Range("A22:P" & loLetzteQuelle).AutoFilter Field:=2, Criteria1:="", Operator:=xlFilterValues
raBereich.Copy
tbl_2_Positionen.Cells(loLetzteZiel, "B").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
tbl_2_Positionen.Cells(loLetzteZiel, "B").PasteSpecial Paste:=xlPasteFormats
.Range("A22").AutoFilter
End With
Application.CutCopyMode = False
Set raBereich = Nothing
End Sub
Gruß Werner
Anzeige
verbundene Zellen
06.10.2021 07:40:10
Klaus
Hallo Eisi,
im Positionen-Blatt sind verbundene Zellen. Das Makro kann eine Range nicht einfügen, wenn im Einfügebereich Verbundzellen sind. AM einfachsten: nimm alle verbundenen Zellen raus und löse die Darstellung anders.
Wie gesagt, das Makro selbst ist Fehlerfrei ....
LG,
Klaus M.
Anzeige
Muster-Mappe neu__AW: Code ist Fehlerfrei
06.10.2021 12:34:12
Eisi
https://www.herber.de/bbs/user/148456.xlsm
Hallo Werner,
Hallo Klaus,
Mit der neuen Mustermappe sollte mein Plan besser verständlich sein.
Es sollen die verschiedenen Tabellenbereiche mit einem Button ins Sheet: 2_Positionen übertragen werden.
Mit jedem Click auf den Button soll der neue Tabellenbereich mit einer Leerzeile unter der oberen Tabelle eingefügt werden.
Mir ist auch aufgefallen, dass ich die Einfügeposition in 2_Positionen gar nicht festgelegt habe. Die ist nämlich B10. Ich könnte aber in B8 einen Blindtext schreiben und der Code würde quasi darunter die Tabellen einfügen.
@Klaus: Ich habe im Zielblatt mal die ganzen Zellverbindungen rausgenommen, bekomme aber immer noch den Fehler?
Vielen Dank für die Hilfe.
VG Eisi :-)
Anzeige
Muster-Mappe neu__AW: Code ist Fehlerfrei
06.10.2021 13:14:00
Klaus
Klaus: Ich habe im Zielblatt mal die ganzen Zellverbindungen rausgenommen
Hast du nicht. B2:L9 sind immer noch ein großer Zellenverbund. Löse ich den auf, funktioniert auch das Makro wie es soll.
LG,
Klaus M.
Muster-Mappe neu__AW: Code ist Fehlerfrei
06.10.2021 13:44:05
Eisi
Jetzt sehe ich es erst. In diesem Bereich lag ja die Textbox über den Zellen.
In diesem Bereich sollte ja gar nichts eingefügt werden, sondern erst ab Zelle B10. Die weißen Bereich haben ja überhaupt keinen Zellenverbund.
Jetzt muss ich nur noch rausfinden, wie ich nur die erste Tabelle ab B10 einfüge. Das schaffe ich wohl nicht. Ich werde wohl die Tabellen ab Zelle B1 übertragen müssen. Muss ich noch ausprobieren.
Obwohl, ich habe die Tabelle ja deshalb so gestaltet, damit ich die Seitenumbrüche sehe und per Hand die Tabellen verschieben kann. Das macht nur Sinn ab B10.
Hast Du da eine Idee dazu?
Vielen Dank für Deine Hilfe :-)
GLG Eisi :-)
Anzeige
Hilfe :-) kopiert nur den Filter
06.10.2021 17:34:17
Eisi
https://www.herber.de/bbs/user/148472.xlsm
Hallo Karl,
Hallo Werner,
leider komme ich nicht weiter. Es werden zwar jetzt die Werte und Formate kopiert, aber in die falsche Position und nur die halbe Tabelle.
Ziel:
1. Kopiere die einzelnen Tabellenbereiche ab Zelle B10 rein. Die nächste Tabelle mit einer Leerzeile darunter.
2. Kopiere die jeweiligen Tabellenbereich komplett, bei der ersten Tabelle als Beispiel F15:P43, aber kopiere mit Filter = 0 oder > 0.
Leere Zellen sollen also nicht kopiert werden.
Im Sheet "2_Positionen_Muster" ist das schön zu sehen.
Der rote Button, der neben jedem Tabellenbereich steht löst den Vorgang aus.
Habt ihr da eine Lösung für mich, oder muss ich die Tabelle anders aufbauen?
Vielen herzlichen Dank für die Geduld und Unterstützung.
VG Eisi :-)
Anzeige
AW: Hilfe :-) kopiert nur den Filter
06.10.2021 18:10:27
Eisi
Bereich komplett kopieren geht jetzt, weil ich den Filter jetzt anders einstelle, nämlich so, was wahrscheinlich wohl jeder macht ;-):
tbl_1_Kalkulation.Range("A22:P34").AutoFilter Field:=2, Criteria1:=""
Jetzt muss ich nur noch rausfinden wie ich ab der Zelle B10 anfange und jede weitere Tabelle 2 Zeilen darunter setzte.
Anzeige
Unfassbar :-) AW: Hilfe :-) kopiert nur den Filter
06.10.2021 19:04:16
Eisi
Jetzt ist es 19 Uhr und ich habe die Lösung erarbeitet. Unfassbar, ich kann es noch gar nicht glauben.
Ob die Lösung jetzt gut ist, weiß ich nicht, aber ich bekomme jetzt das Ergebnis wie ich es brauche.

Private Sub AngebotsMengePlattenUebertragen_Click()
If (Sheets("2_Positionen").Range("B10"))  "" Then
KopierenNachLetzerTabelle
Else
KopierenNachZelleB10
End If
End Sub
'____________________________________________________________________________________________________________________
Sub KopierenNachZelleB10()
Application.ScreenUpdating = False
'*** Deklaration Copy
Dim lngZeileMax As Long
Dim rngBereich As Range
Dim rngBereichFormat As Range
Dim lastrow As Long
'*** 1) Filter setzen und leere Zellen ausblenden
tbl_1_Kalkulation.Range("A22:P34").AutoFilter Field:=2, Criteria1:=""
'*** 2) Kopiere den gefilterten Bereich
tbl_1_Kalkulation.Range("F15:P43").Copy
'*** 3) Letzte Zelle in Spalte 8 festlegen und Kopie 2 Zellen darunter einfügen
With tbl_2_Positionen
lastrow = .Cells(.Rows.Count, 2).End(xlUp).Row + 9 ' Letzte Zelle in Spalte 2 finden + 9 Zeilen darunter einfügen
.Cells(lastrow, 2).PasteSpecial Paste:=xlValues 'Fügt die kopierten Werte ein.
.Cells(lastrow, 2).PasteSpecial Paste:=xlPasteFormats 'Überträgt die Formatierung.
End With
Application.CutCopyMode = False
tbl_1_Kalkulation.AutoFilterMode = False
Application.Goto tbl_1_Kalkulation.Range("A13")
Application.ScreenUpdating = True
End Sub '_________________________________________________________________________________________________________
Sub KopierenNachLetzerTabelle()
Application.ScreenUpdating = False
'*** Deklaration Copy
Dim lngZeileMax As Long
Dim rngBereich As Range
Dim rngBereichFormat As Range
Dim lastrow As Long
'*** 1) Filter setzen und leere Zellen ausblenden
tbl_1_Kalkulation.Range("A22:P34").AutoFilter Field:=2, Criteria1:=""
'*** 2) Kopiere den gefilterten Bereich
tbl_1_Kalkulation.Range("F15:P43").Copy
'*** 3) Letzte Zelle in Spalte 8 festlegen und Kopie 2 Zellen darunter einfügen
With tbl_2_Positionen
lastrow = .Cells(.Rows.Count, 2).End(xlUp).Row + 2 ' Letzte Zelle in Spalte 2 finden + 2 Zeilen darunter einfügen
.Cells(lastrow, 2).PasteSpecial Paste:=xlValues 'Fügt die kopierten Werte ein.
.Cells(lastrow, 2).PasteSpecial Paste:=xlPasteFormats 'Überträgt die Formatierung.
End With
Application.CutCopyMode = False
tbl_1_Kalkulation.AutoFilterMode = False
Application.Goto tbl_1_Kalkulation.Range("A13")
Application.ScreenUpdating = True
End Sub
Anzeige
;

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige