Fehlermeldung:
Laufzeitfehler: 1004
Die Methode PasteSpecial für das Objekt Worksheet ist fehlgeschlagen
Lösung:
'----< Bereich ausgeben >---- Dim wsExport As Worksheet Set wsExport = workbook_Export.Sheets("Tabelle1") '< copy_paste > range_Ausgabe.Copy wsExport.Range("A1").Select Application.Selection.Cells.PasteSpecial Paste:=xlValues '</ copy_paste > |
Vba Code zum Exportieren von Zellen in Excel über die Zwischenablage
Public Sub FB_Erlaeuterung_erstellen(ByVal sKostenstelle As String, ByVal sFachbereich As String, ByVal sDatei As String) '------------< FB_Erlaeuterung_erstellen() >------------ '-< init >- Dim wb As Workbook Set wb = ActiveWorkbook
Dim ws_Ausgabe As Worksheet Set ws_Ausgabe = wb.Worksheets("FB_Erläuterungen")
Dim sAusgabebereich As String sAusgabebereich = wb.Names("FB_Ausgabebereich").RefersToRange.Value '*Ausgabe-Bild-Bereich in KER wie: G13:BL51
Dim range_Ausgabe As Range Set range_Ausgabe = ws_Ausgabe.Range(sAusgabebereich) '-</ init >-
'< speed > ws_Ausgabe.DisplayPageBreaks = False Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = False '*speed row ausblenden true->false Application.EnableEvents = False '< speed >
'----< Ausgabeblatt_anpassen >------ '< Kostenstelle einstellen > wb.Names("FB_Kostenstelle").RefersToRange.Value = sKostenstelle If Application.Calculation <> xlCalculationAutomatic Then Application.Calculate '</ Kostenstelle einstellen >
'< Zeilen ausblenden > FB_Leere_Zeilen_ausblenden '</ Zeilen ausblenden > '----</ Ausgabeblatt_anpassen >------
'----< AusgabeDatei_erstellen >---- Application.StatusBar = Now & " erstelle Ausgabedatei.."
'< delete_sheet1 > Dim workbook_Export As Workbook Set workbook_Export = Workbooks.Add()
'< Design-Farb-Schema uebernehmen > workbook_Export.ApplyTheme wb.FullName '</ Design-Farb-Schema uebernehmen >
Application.DisplayAlerts = False '*suppress alert: delete sheet1 und save.overwrite '</ delete_sheet1 >
'----< Bereich ausgeben >---- Dim wsExport As Worksheet Set wsExport = workbook_Export.Sheets("Tabelle1") wsExport.Name = "Erläuterungen" '< copy_paste > range_Ausgabe.Copy wsExport.Range("A1").Select Application.Selection.Cells.PasteSpecial Paste:=xlValues '</ copy_paste >
'----</ Bereich ausgeben >---- '< Anzeige anpassen > workbook_Export.Application.ActiveWindow.DisplayGridlines = False Verlinkungen_loeschen_Arbeitsmappe workbook_Export '</ Anzeige anpassen >
'< Breiten Hoehen uebernehmen > Dim iColumn As Integer For iColumn = 1 To range_Ausgabe.Columns.Count wsExport.Columns(iColumn).ColumnWidth = range_Ausgabe.Columns(iColumn).ColumnWidth Next Dim iRow As Integer For iRow = 1 To range_Ausgabe.Rows.Count wsExport.Rows(iRow).RowHeight = range_Ausgabe.Rows(iRow).RowHeight Next '</ Breiten Hoehen uebernehmen > '< save > Application.DisplayAlerts = False Application.StatusBar = Now & "speichern Datei: " & sFachbereich
Dim sMonatskennung As String sMonatskennung = wb.Names("Monat_Kennung").RefersToRange.Value workbook_Export.SaveAs sDatei '</ save >
workbook_Export.Close Set workbook_Export = Nothing Application.DisplayAlerts = True
'< speed > ws_Ausgabe.DisplayPageBreaks = True Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True '*speed row ausblenden true->false Application.EnableEvents = True '< speed >
Application.StatusBar = Now & " fertig: Datei ausgeben" '-----------------</ AusgabeDatei_erstellen() >----------------- '------------</ FB_Erlaeuterung_erstellen() >------------ End Sub |
Alter Code
Public Sub FB_Erlaeuterung_erstellen(ByVal sKostenstelle As String, ByVal sFachbereich As String, ByVal sDatei As String) '------------< FB_Erlaeuterung_erstellen() >------------ '-< init >- Dim wb As Workbook Set wb = ActiveWorkbook
Dim ws_Ausgabe As Worksheet Set ws_Ausgabe = wb.Worksheets("FB_Erläuterungen")
Dim sAusgabebereich As String sAusgabebereich = wb.Names("FB_Ausgabebereich").RefersToRange.Value '*Ausgabe-Bild-Bereich in KER wie: G13:BL51
Dim range_Ausgabe As Range Set range_Ausgabe = ws_Ausgabe.Range(sAusgabebereich) '-</ init >-
'< speed > ws_Ausgabe.DisplayPageBreaks = False Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = False '*speed row ausblenden true->false Application.EnableEvents = False '< speed >
'----< Ausgabeblatt_anpassen >------ '< Kostenstelle einstellen > wb.Names("FB_Kostenstelle").RefersToRange.Value = sKostenstelle If Application.Calculation <> xlCalculationAutomatic Then Application.Calculate '</ Kostenstelle einstellen >
'< Zeilen ausblenden > FB_Leere_Zeilen_ausblenden '</ Zeilen ausblenden > '----</ Ausgabeblatt_anpassen >------
'----< AusgabeDatei_erstellen >---- Application.StatusBar = Now & " erstelle Ausgabedatei.."
'< delete_sheet1 > Dim workbook_Export As Workbook Set workbook_Export = Workbooks.Add()
'< Design-Farb-Schema uebernehmen > workbook_Export.ApplyTheme wb.FullName '</ Design-Farb-Schema uebernehmen >
Application.DisplayAlerts = False '*suppress alert: delete sheet1 und save.overwrite '</ delete_sheet1 >
'----< Bereich ausgeben >---- Dim wsExport As Worksheet Set wsExport = workbook_Export.Sheets("Tabelle1") wsExport.Name = "Erläuterungen"
range_Ausgabe.Copy wsExport.Range("A1").Select wsExport.PasteSpecial xlValues
'----</ Bereich ausgeben >---- '< Anzeige anpassen > workbook_Export.Application.ActiveWindow.DisplayGridlines = False Verlinkungen_loeschen_Arbeitsmappe workbook_Export '</ Anzeige anpassen >
'< Breiten Hoehen uebernehmen > Dim iColumn As Integer For iColumn = 1 To range_Ausgabe.Columns.Count wsExport.Columns(iColumn).ColumnWidth = range_Ausgabe.Columns(iColumn).ColumnWidth Next Dim iRow As Integer For iRow = 1 To range_Ausgabe.Rows.Count wsExport.Rows(iRow).RowHeight = range_Ausgabe.Rows(iRow).RowHeight Next '</ Breiten Hoehen uebernehmen > '< save > Application.DisplayAlerts = False Application.StatusBar = Now & "speichern Datei: " & sFachbereich
Dim sMonatskennung As String sMonatskennung = wb.Names("Monat_Kennung").RefersToRange.Value workbook_Export.SaveAs sDatei '</ save >
workbook_Export.Close Set workbook_Export = Nothing Application.DisplayAlerts = True
'< speed > ws_Ausgabe.DisplayPageBreaks = True Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True '*speed row ausblenden true->false Application.EnableEvents = True '< speed >
Application.StatusBar = Now & " fertig: Datei ausgeben" '-----------------</ AusgabeDatei_erstellen() >----------------- '------------</ FB_Erlaeuterung_erstellen() >------------ End Sub |