Makro: Tabellenblatt - kopieren (nur Werte)

Question

Hallo,

mein Makro - funktioniert nicht: der Range Befehl wird nicht ausgeführt und ein Laufzeitfehler (1004) angezeigt.

Wahrscheinlich hängt es am Select Befehl.

Kann mir jemand helfen.

---------------


Private Sub CommandButton_ESi_Blatt_öffnen_Click()

    Dim rücksprungBlatt As Worksheet
    Set rücksprungBlatt = ActiveSheet

    Sheets("ESi_Tabellenblatt1").Visible = True
    Sheets("ESi_Tabellenblatt1").Select
    Sheets("ESi_Tabellenblatt1").Copy
    Sheets("ESi_Tabellenblatt1").Select
    'Range("B3:F3") = Range("B3:F3").Value
    'Range("B4:F11") = Range("B4:F11").Value
    MsgBox "Bitte vor der weiteren Bearbeitung dieses Excel Blatt speichern"
    Application.Dialogs(xlDialogSaveAs).Show sFilename, xlOpenXMLWorkbook
    
    rücksprungBlatt.Activate
    Sheets("ESi_Tabellenblatt1").Select
    ActiveSheet.Visible = xlSheetVeryHidden
    
End Sub

Answer 1

Hallo,

in welches Tabellenblatt sollen denn die kopierten Daten eingefügt werden? Sollen etwa die Werte aus dem Tabellenblatt ESi_Tabellenblatt in das kopierte Tabellenblatt ESi_Tabellenblatt eingefügt werden?

Dann probier es mal so:

[code]Private Sub CommandButton_ESi_Blatt_öffnen_Click()

Dim wksQuelle As Worksheet
Dim rücksprungBlatt As Worksheet
Dim Neuer_Dateiname
Dim sFilename As String


Set wksQuelle = ThisWorkbook.Worksheets("ESi_Tabellenblatt1")
Set rücksprungBlatt = ActiveSheet

'Pfad und Name der zu speichernden Datei festlegen; wird als xlsx-Datei gespeichert
sFilename = "D:\Test " & Year(Now) & "_" & Month(Now) & "_" & Day(Now) & ".xlsx"

'Blatt einblenden und kopieren
With wksQuelle
 .Visible = True
 .Copy
 'Werte von Original in die Kopie übertragen
 ActiveSheet.Range("B3:F3") = .Range("B3:F3").Value
 ActiveSheet.Range("B4:F11") = .Range("B4:F11").Value
 
 MsgBox "Bitte vor der weiteren Bearbeitung dieses Excel Blatt speichern"
 
 'Speichern unter mit Pfadvorgabe und Name
 Neuer_Dateiname = Application.GetSaveAsFilename(InitialFileName:=sFilename, fileFilter:="Excel-Arbeitsmappe ohne Makros, *.xlsx")
 If Neuer_Dateiname = False Then
  'falls die Datei nicht gespeichert wird, könnte man z.B. die Datei schließen, ohne zu speichern
   ActiveWorkbook.Close (False)
  End If
 'kopiertes Blatt speichern
 ActiveWorkbook.SaveAs Filename:=Neuer_Dateiname

 .Visible = xlSheetVeryHidden

End With

rücksprungBlatt.Activate

End Sub[/code]

Gruß

M.O.

Answer 2

Hallo M.O.,

danke erst mal für Deine Mühe ...

Das Makro funktioniert. Allerdings wird im Dialog Speichern unter - nach anklicken auf "[u]Abbrechen[/u]" wird ein Dialog angezeigt.

[b]Eine Datei mit dem Namen 'FALSE.xlxm' ist bereits an diesem Speicherort vorhanden. Soll diese ersetzt werden?[/b]

Das Beenden dieses Dialogs durch die Auswahl "[u]Abbrechen[/u]" oder "[u]Nein[/u]" führt zu einem Laufzeitfehler '1004': Die Methode 'SaveAs' für das Objekt '_Workbook" ist fehlgeschlagen.

Das Abbrechen soll ohne Fehlermeldung möglich sein? ?? :)

Answer 3

Hallo happy1998,

ja da habe ich ein Exit Sub vergessen :-(.

So sollte es funktionieren:
[code]...
If Neuer_Dateiname = False Then
  'falls die Datei nicht gespeichert wird, könnte man z.B. die Datei schließen, ohne zu speichern
   ActiveWorkbook.Close (False)
   Exit Sub
End If
...[/code]

Gruß

M.O.

Answer 4

Hallo M.O.

Danke .... vlt. lerne ich das auch noch :)