Readdy Write

Excel vba: Copy Paste Values . Gelöst Laufzeitfehler: 1004

04.04.2019 (👁11706)

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


0,00 €