Probleme mit Excel VBA - Kopieren von Bereichen bzw. Arbeitsblatt

Hallo zusammen,
ich möchte gern aus einer Excel-Datei werte aus einer Tabelle kopieren in ein anderes Excel File kopieren.
Dazu würde ich erst die "Tabelle1" aus der Quelldatei in die Zieldatei kopieren. Anschließend meine Werte von der Tabelle in eine andere.
Das Problem was ich habe ist, dass ich permanent einen Fehler bekomme, dass der Index außerhalb des Gültigen Bereichs sei.

Hier mal mein Code:

Sub Daten()
    quelle = Application.GetOpenFilename()
    If quelle = False Then GoTo Mark1
    ziel = Application.GetOpenFilename()
    If ziel = False Then GoTo Mark2
    Workbooks.Open quelle
    Workbooks.Open ziel
    
    cnt = ActiveWorkbook.Sheets.Count
    ActiveWorkbook.Sheets("Tabelle1").Copy after:=Workbooks(ziel).Sheets(cnt)  
    
    'Workbooks(quelle).Sheets("Tabelle1").Copy after:=Workbooks(ziel).Sheets(cnt)  
    'Workbooks.Open (ziel)  
    
    
    msgbox "Daten wurden übernommen.", vbokonly  
    GoTo Ende
    
Mark1:
    MsgBox "Es wurde keine Quelldatei ausgewählt.", vbOKOnly  
    GoTo Ende
    
Mark2:
    MsgBox "Es wurde keine Zieldatei ausgewählt.", vbOKOnly  


Ende:
    
End Sub

Die Kopierte Tabelle soll dann zum Schluss wieder gelöscht werden.

Gruß

Please also mark the comments that contributed to the solution of the article

Content-Key: 254731

Url: https://administrator.de/contentid/254731

Printed on: April 23, 2024 at 17:04 o'clock

3 Comments

Latest comment

Hi killtec,
du solltest beim öffnen mehrerer Workbooks am besten die Referenzen der Workbooks Variablen zuweisen und diese für den Zugriff benutzen.

Sub Daten()
    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 Quelldatei ausgewählt.", vbOKOnly  
        Exit Sub
    End If

    Application.ScreenUpdating = False

    'Workbooks öffnen  
    Set wbQuelle = Workbooks.Open(strPathQuelle)
    Set wbZiel = Workbooks.Open(strPathZiel)
    
    'Sheet kopieren  
    wbQuelle.Worksheets("Tabelle1").Copy After:=wbZiel.Worksheets(wbZiel.Worksheets.Count)  
    
    'Quell-Workbook schließen (nicht speichern)  
    wbQuelle.Close 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

Grüße Uwe

Danke Uwe,
Auf dich ist Verlass

Ich habe den code noch ein wenig angepasst. Poste nachher mal das Ergebnis wenn ich alles habe.
Schönes Wochenende.

Gruß

Hi Uwe,
hier mein Code:

Sub Daten()
  MsgBox "Bitte zuerst die Quelle und anschließend das Ziel auswählen.", vbOKOnly  
    
    strQuelle = Application.GetOpenFilename()
    If strQuelle = False Then
        MsgBox "Es wurde keine Quelldatei ausgewählt.", vbOKOnly  
        Exit Sub
    End If
    
   strZiel = Application.GetOpenFilename()
   If strZiel = False Then
       MsgBox "Es wurde keine Zieldatei ausgewählt.", vbOKOnly  
       Exit Sub
   End If
    
'Aktualisierung abschalten  
    Application.ScreenUpdating = False
    
'Setzen der Quelle und Ziel in eine Variable  
    Set quelle = Workbooks.Open(strQuelle)
    Set ziel = Workbooks.Open(strZiel)
    
'Qulle prüfen. Als Referenz wird der Begriff "Refwert" in Zelle A26 genommen.  

    refval = quelle.Worksheets("Tabelle1").Range("A26").Value  
    If refval <> "Refwert" Then  
    
        MsgBox "Die Quelldatei entspricht nicht dem korrektem Datenmuster. Bitte prüfen Sie Die Quelldatei.", vbOKOnly + vbCritical  
        Exit Sub
    
    End If
    
'Kopieren der Tabelle "Tabelle1"  
    quelle.Worksheets("Tabelle1").Copy After:=ziel.Worksheets(ziel.Worksheets.Count)  
    quelle.Close False
    

    
'T_Table1  
    StrSheet = "T_Table1"  
    ziel.Sheets("Tabelle1").Range("B26:D36,B38:D43").Select  
    Application.CutCopyMode = False
    Selection.Copy
    ziel.Sheets(StrSheet).Select
    Range("C3").Select  
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
            

'T_Table2  
    StrSheet = "T_Table2"  
    ziel.Sheets("Tabelle1").Activate  
    ziel.Sheets("Tabelle1").Range("B49:D59,B61:D66").Select  
    Application.CutCopyMode = False
    Selection.Copy
    ziel.Sheets(StrSheet).Select
    Range("C3").Select  
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
  

'T_Table3  
    StrSheet = "T_Table3"  
    ziel.Sheets("Tabelle1").Activate  
    ziel.Sheets("Tabelle1").Range("B73:D80").Select  
    Application.CutCopyMode = False
    Selection.Copy
    ziel.Sheets(StrSheet).Select
    Range("C3").Select  
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


    
'T_Table4  
    StrSheet = "T_Table4"  
    ziel.Sheets("Tabelle1").Activate  
    ziel.Sheets("Tabelle1").Range("B9:D9,F9:G9,B11:D11,F11:G11,B13:D13,F13:G13,B15:D15,F15:G15,B17:D17,F17:G17,B19:D19,F19:G19").Select  
    Application.CutCopyMode = False
    Selection.Copy
    ziel.Sheets(StrSheet).Select
    Range("C4").Select  
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    
'Löschen des Arbeitsblattes  
    Application.DisplayAlerts = False
    ziel.Sheets("Tabelle1").Delete  
    Application.DisplayAlerts = True
    
    
    MsgBox "Daten wurden übernommen.", vbOKOnly  
   
    
End Sub

Jetzt muss ich nur noch ein bisschen Bedingte Formatierung einbauen.

Gruß

German solved Question VB for Applications Development

Hotly discussed

Check of ZFW Firewallgleixnerd - 5 Comments

Wireguard VPN on UDM Pro behind Fritzbox - Handshake did not completejstricker - 3 Comments

How to set up and configure a Linux GRE tunnelAlexWisha - 3 Comments