Fehler PasteSpecial

Hallo zusammen,
ich versuche mit einem VBA-Code ein Excelblatt zu kopieren und anschließend ohne Formeln als Werte mit gleicher Formatierung in einem neuen Tabellenblatt zu öffnen. Der Code klappt bei einem einfachen Blatt tadellos. Ich möchte den Code aber für ein Blatt mit einigen Formeln nutzen, auf dem Leer-Zeilen mit einem Auto-Filter ausgeblendet werden. Diese ausgeblendeten Leerzeilen sollen nicht mitkopiert werden. Wenn ich den Code aktivier, wird das Tabellenblatt in einer neuen Tabelle geöffnent und es wird alles kopiert (inkl. Formeln). Dabei erhalte ich den Fehler "Laufzeit-Fehler 1004: Sie können dies hier nicht einfügen, da der Kopier-Bereich und der Einfügebereich nicht die gleiche Größe haben..."
Ich nutze Excel 2016. Der Code sieht folgendermaßen aus:


Private Sub CommandButton2_Click()
Dim strTabelle As String
strTabelle = "Proforma Product engl."
Sheets(strTabelle).Copy
With ActiveSheet.UsedRange
.Copy
.PasteSpecial Paste:=xlValues
End With
Application.CutCopyMode = False
For intAnzahl = ActiveSheet.OLEObjects.Count To 1 Step -1
If ActiveSheet.OLEObjects(intAnzahl).progID = "Forms.CommandButton.2" Then
ActiveSheet.OLEObjects(intAnzahl).Delete
End If
Next
FileSaveName = Application.GetSaveAsFilename(fileFilter:="Microsoft Excel-Arbeitsmappe (*.xlsx), _
_
_
*.xlsx")
If FileSaveName  False Then
ActiveWorkbook.SaveAs FileSaveName
End If
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub ExcelNeu() ' ExcelNeu Makro Sheets("Proforma Product engl.").Select Sheets("Proforma Product engl.").Copy Cells.Select Selection.ClearContents Windows("TabelleBasis.xlsm").Activate Cells.Select Selection.Copy Windows("Mappe1").Activate 'Beim nächsten mal heißt die Mappe nicht mehr "Mappe 1" Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _ , SkipBlanks:=False, Transpose:=False Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End Sub

Sub ExcelNeu() Dim wsQuelle As Worksheet Dim wsZiel As Worksheet '--- Quellblatt festlegen Set wsQuelle = ThisWorkbook.Sheets("Proforma Product engl.") '--- Blatt in neue Mappe kopieren wsQuelle.Copy Set wsZiel = ActiveSheet '--- Autofilter falls vorhanden ausschalten On Error Resume Next wsZiel.ShowAllData On Error GoTo 0 '---- Zielblatt leeren und INhalte und Formate erneut kopieren wsZiel.Cells.Clear wsQuelle.Cells.Copy wsZiel.Cells(1, 1).PasteSpecial Paste:=xlPasteAllUsingSourceTheme wsZiel.Cells(1, 1).PasteSpecial Paste:=xlPasteValues '--- Zum Ausgangsblatt zur?ck ThisWorkbook.Activate Application.CutCopyMode = False End Sub

HI
im Prinzip gibt's zwei Möglichkeiten:
a) alles kopieren und löschen was man nicht braucht
b) leeres Blatt anlegen und nur das rüberkopieren, was man braucht.
je weniger man behalten möchte, um so sinnvoller ist Variante b)
Makros rauslöschen ist schwierig und aufwendig, da ist Speichern als xlsx das einfachste.
wenn das mit den Kopf- und Fußzeilen schwierig zu programmieren ist, kannst du dir auch ein leeres Vorlagenblatt ohne Makros aber mit der passenden Seiteneinrichtung erstellen. Da kopierst du deine Inhalte dann rein und erstellst daraus dann die neue Datei.
Immer wenns um die Seiteneinrichtung (da gehören die Kopf- und Fusszeilen mit dazu) geht, wird Excel langsam.
Davon ist leider auch das Kopieren eines Tabellenblatts betroffen, weil hier ja auch diese Einstellungen mit übernommen werden.
Anscheinend hält Excel dann mit dem Druckertreiber erstmal ein Kaffekränzchen.
Es hilft dann manchmal, den Vorgang in diese Befehlszeilen einzubetten, um das Kaffekränzchen zu vermeiden:

Application.PrintCommunication = False
hier der Code zum Blattkopieren oder Seiteeinrichten
Application.PrintCommunication = True

Gruß Daniel

Sub KopieInExcel() Selection.Copy Sheets("Proforma Product engl. (2)").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.ClearContents Sheets("Proforma Product engl.").Select Selection.Copy Sheets("Proforma Product engl. (2)").Select Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _ , SkipBlanks:=False, Transpose:=False Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False '--- CommandButton entfernen For intAnzahl = ActiveSheet.OLEObjects.Count To 1 Step -1 If ActiveSheet.OLEObjects(intAnzahl).progID = "Forms.CommandButton.1" Then ActiveSheet.OLEObjects(intAnzahl).Delete End If Next Sheets("Proforma Product engl.").Activate Sheets("Proforma Product engl. (2)").Copy '--- Speichern aufrufen FileSaveName = Application.GetSaveAsFilename(fileFilter:="Microsoft Excel-Arbeitsmappe (*.xlsx), _ *.xlsx") If FileSaveName False Then ActiveWorkbook.SaveAs FileSaveName End If End Sub

Sub ProformaProductEnglInExcel() Range("A1:E89").Select Selection.Copy Sheets("Proforma Product engl. (2)").Select Range("A1").Select ActiveSheet.Paste ActiveWindow.SmallScroll Down:=18 Selection.Rows.AutoFit ' Sheet anzeigen Sheets("Proforma Product engl.").Activate ' Kopie erstellen Sheets("Proforma Product engl. (2)").Copy 'Speichern aufrufen FileSaveName = Application.GetSaveAsFilename(fileFilter:="Microsoft Excel-Arbeitsmappe (*. _ xlsx), *.xlsx") If FileSaveName False Then ActiveWorkbook.SaveAs FileSaveName End If Application.CutCopyMode = False End Sub

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

23 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Fehler PasteSpecial

13 Beiträge zum Forumthread Beiträge zu diesem Forumthread

23 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread