Datei Tabellenblatt kopieren

Der Kode macht in Zeile

MkDir DestFolder

probleme. Fehlermeldung: Laufzeitfehler 75, Fehler beim Zugriff auf Pfad / Datei. Für mich sind die Pfade richtig geschrieben, verstehe die Meldung daher nicht.

Sub KopiereDatei()
    Dim FSO As Object
    Dim SourceFile As String
    Dim DestFolder As String

    SourceFile = "C:\Users\Besitzer\Desktop\Datei für DEMO\Info.xlsb"   ' Pfad zur Quelldatei  

    DestFolder = "C:\Users\Besitzer\Desktop\Tabelle_Test.xlsx"          ' Pfad zum Zielordner (ohne Dateiname)  

    If Not FolderExists(DestFolder) Then                                ' Überprüfen, ob der Zielordner existiert, wenn nicht, erstellen  
        MkDir DestFolder
    End If

    Set FSO = CreateObject("Scripting.FileSystemObject")                ' Erstellen des FileSystemObject  

    If FSO.FileExists(SourceFile) Then                                  ' Kopieren der Datei  
        FSO.CopyFile Source:=SourceFile, Destination:=DestFolder
        MsgBox "Die Datei wurde erfolgreich kopiert.", vbInformation  
    Else
        MsgBox "Die Quelldatei wurde nicht gefunden.", vbExclamation  
    End If

    Set FSO = Nothing                                                   ' Freigabe des FileSystemObject  
End Sub

Function FolderExists(ByVal FolderPath As String) As Boolean
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")  
    FolderExists = FSO.FolderExists(FolderPath)
    Set FSO = Nothing
End Function

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 5322735252

Url: https://administrator.de/forum/datei-tabellenblatt-kopieren-5322735252.html

Ausgedruckt am: 25.12.2024 um 07:12 Uhr

8 Kommentare

Neuester Kommentar

Hi.

Zeile 8: DestFolder = "C:\Users\Besitzer\Desktop\Tabelle_Test.xlsx" ' Pfad zum Zielordner (ohne Dateiname)

Lies mal den Kommentar(nach dem Hochkomma) durch und was mkdir so veranstaltet. Dann kommste alleine auf die Lösung (und auch darauf, warum das gar nicht funktionieren sollte).

Gruß

Der Kode produziert mir dann einen neuen Ordner, aber keine neue Datei mit Inhalt.

Was auch sonst? Works as designed.
MkDir erzeugt ein Directory/einen Ordner.
Du sagt: erzeuge den Ordner "C:\Users\Besitzer\Desktop\Tabelle_Test.xlsx".
Das passiert. Der Ordner heißt "Tabelle_Test.xlsx". Das ist ein zulässiger Ordnername, wie auch ein zulässiger Dateiname. Hier ein Ordnername.

Da dann der Ordner "Tabelle_Test.xlsx" unter Desktop besteht, muss der Kopiervorgang fehlschlagen. In einem Ordner (hier: Desktop) können nicht ein Unterordner und eine Datei identischen Namens existieren.

Du willst aber wohl eher (oder Dein AI-Code, den Du nicht verstehst?):
1. Prüfe, ob der Zielordner existiert (bei Desktop eher sinnfrei...).
2. Falls nicht, erzeuge Zielordner
3. Kopiere dann die Quelldatei in den Zielordner

Dann muss der Zielordner schlicht "C:\Users\Besitzer\Desktop" heißen.

Lies Dir auch mal die Beschreibung von CopyFile durch.

Gruß

DivideByZero

Hallo, ich muss meine Frage ergänzen, denn ich wollte aus der "Datei für Demo" nur die Tabelle "Info" kopieren, und diese als neue Datei auf dem Desktop einfügen. Mein neuer Code s. u. kopiert mir aber die Datei. Das ist mein eigentliches Problem

Sub KopiereDatei()
    Dim FSO As Object
    Dim SourceFile As String
    Dim DestFolder As String
    
    ' Pfad zur Quelldatei  
    SourceFile = "C:\Users\Besitzer\Desktop\Datei für DEMO.xlsb"  
    
    ' Pfad zum Zielordner (ohne Dateiname)  
    DestFolder = "C:\Users\Besitzer\Desktop\Tabelle_Test\"  
    
    ' Erstellen des FileSystemObject  
    Set FSO = CreateObject("Scripting.FileSystemObject")  
    
    ' Überprüfen und Erstellen des Zielordners, falls nicht vorhanden  
    If Not FSO.FolderExists(DestFolder) Then
        MkDir DestFolder
    End If
    
    ' Kopieren der Datei  
    If FSO.FileExists(SourceFile) Then
        FSO.CopyFile Source:=SourceFile, Destination:=DestFolder
        MsgBox "Die Datei wurde erfolgreich kopiert.", vbInformation  
    Else
        MsgBox "Die Quelldatei wurde nicht gefunden.", vbExclamation  
    End If
    
    ' Freigabe des FileSystemObject  
    Set FSO = Nothing
End Sub

Probleme mit Excel VBA - Kopieren von Bereichen bzw. Arbeitsblatt

Gruß pp

Habe ich jetzt verwendet, in der MsgBox werde ich nach der Datei gefragt, aber wie wähle ich denn das entsprechende Tabellenblatt (Quelldatei) aus, welches ich kopieren will?

Zitat von @mark47:

Habe ich jetzt verwendet, in der MsgBox werde ich nach der Datei gefragt, aber wie wähle ich denn das entsprechende Tabellenblatt (Quelldatei) aus, welches ich kopieren will?

Indem du mal die Kommentare des Codes liest ... 💩

' ....  
    'Sheet kopieren    
    wbQuelle.Worksheets("Tabelle1").Copy After:=wbZiel.Worksheets(wbZiel.Worksheets.Count)    
    

Hallo und Danke für die Hinweise. Der Code funktioniert perfekt. Eine Frage hätte ich aber noch. Kann man beim Kopieren der Tabelle die Herkunft der Formeln ohne den "Pfad" mitzukopieren einrichten?

Private Sub CommandButton1_Click()

    Dim wbQuelle As Workbook, wbZiel As Workbook, strPathQuelle, strPathZiel

    'Dateinamen anfordern  
    strPathQuelle = Application.GetOpenFilename()
    strPathZiel = Application.GetOpenFilename()
    
    If strPathQuelle = False Then
        MsgBox "Es wurde keine Quelldatei ausgewählt.", vbOKOnly  
        Exit Sub
    End If
    If strPathZiel = False Then
        MsgBox "Es wurde keine Zieldatei ausgewählt.", vbOKOnly  
        Exit Sub
    End If

    Application.ScreenUpdating = False

    'Workbooks öffnen  
    Set wbQuelle = Workbooks.Open(strPathQuelle)
    Set wbZiel = Workbooks.Open(strPathZiel)
    
    ' Tabellenblatt (Sheet) kopieren  
    ' Hier muß das zu kopierende Tabellenblatt ("   ") eingetragen werden.  
    wbQuelle.Worksheets("Info").Copy After:=wbZiel.Worksheets(wbZiel.Worksheets.Count)  
    
    'Quell-Workbook schließen (nicht speichern)  
    wbQuelle.Close True  '  False  
    'Ziel-Workbook schließen und speichern  
    wbZiel.Close True
    
    'Quell-Workbook löschen  
    ''' Kill (strPathQuelle)  
    
    Application.ScreenUpdating = True
    MsgBox "Daten wurden übernommen.", vbOKOnly  

End Sub