Tabellenblätter aus geschlossener Datei kopieren

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: Tabellenblätter aus geschlossener Datei kopieren
von: Marcel
Geschrieben am: 16.06.2015 16:35:29

Hallo Zusammen
Ich möchte aus einer geschlossenen Datei per VBA gewisse Tabellenblätter in eine neue übernehmen.
Im Internet habe ich einen Code gefunden, bei welchem ich ein Tabellenblatt übertragen kann und dies funktioniert auch.
Wie muss ich nun vorgehen, dass ich insgesamt 4 verschiedene Tabellenblätter übertragen kann?
Fies ist der Code für das eine Tabellenblatt.

Sub DatenHolen()
    Dim WBZiel As Workbook, ExportDatei As Variant
    Dim WBQuelle As Workbook, WSZiel As Worksheet
    
    Set WBZiel = ThisWorkbook
    
    'DateiÖffnen Dialog anbieten
    ExportDatei = Application.GetOpenFilename("Micrsoft Excel-Dateien (*.xls),*.xls", , "Bitte  _
die Datei xyz.xls öffnen ...")
    ExportDatei = CStr(ExportDatei)
    If ExportDatei = "Falsch" Then Exit Sub
    
    'öffnen der ausgewählten Datei
    Set WBQuelle = Workbooks.Open(ExportDatei)
    
    'Kopieren der Tabellen „Zeiten“ aus Datei „xyz“
    Set WSZiel = WBZiel.Worksheets.Add(After:=WBZiel.Sheets(WBZiel.Sheets.Count))
    WBQuelle.Worksheets("Zeiten").Cells.Copy WSZiel.Cells(1)
    
    WSZiel.Name = "Zeiten"
    WBQuelle.Close False
    Set WBZiel = Nothing
    Set WBQuelle = Nothing: Set WSZiel = Nothing
End Sub

Die weiteren Tabellenblätter heissen z.B. Material oder MerkmaLE.
Wie muss ich es ergänzen, dass auch die weiteren Tabellenblätter übertragen werden.
Besten Dank für die Hilfe.

Bild

Betrifft: AW: Tabellenblätter aus geschlossener Datei kopieren
von: Sepp
Geschrieben am: 16.06.2015 18:38:17
Hallo Marcel,
das geht z. B. so.

Sub DatenHolen()
  Dim ExportDatei As Variant
  Dim WBQuelle As Workbook, WBZiel As Workbook
  Dim lngCalc As Long
  
  On Error GoTo ErrExit
  
  With Application
    .ScreenUpdating = False
    .EnableEvents = False
    lngCalc = .Calculation
    .Calculation = -4135
    .DisplayAlerts = False
  End With
  
  Set WBZiel = ThisWorkbook
  
  'DateiÖffnen Dialog anbieten
  ExportDatei = Application.GetOpenFilename("Micrsoft Excel-Dateien (*.xls),*.xls", , "Bitte die Datei xyz.xls öffnen ...")
  ExportDatei = CStr(ExportDatei)
  If ExportDatei = "Falsch" Then Exit Sub
  
  'öffnen der ausgewählten Datei
  Set WBQuelle = Workbooks.Open(ExportDatei)
  
  With WBZiel
    WBQuelle.Sheets(Array("Zeiten", "Material", "Merkmale")).Copy After:=.Sheets(.Sheets.Count)
  End With
  
  WBQuelle.Close False
  
  Set WBZiel = Nothing
  Set WBQuelle = Nothing
  
  ErrExit:
  
  With Err
    If .Number <> 0 Then
      MsgBox "Fehler in Prozedur:" & vbTab & "'DatenHolen'" & vbLf & String(60, "_") & _
        vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
        "Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
        .Description & vbLf, vbExclamation + vbMsgBoxSetForeground, _
        "VBA - Fehler in Prozedur - DatenHolen"
      .Clear
    End If
  End With
  
  On Error GoTo 0
  
  With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = lngCalc
    .DisplayAlerts = True
    .StatusBar = False
  End With
  
End Sub


Gruß Sepp


Bild

Betrifft: Korrektur
von: Sepp
Geschrieben am: 16.06.2015 18:40:37
Hallo nochmal,
die Fehlerbehandlung war falsch!

Sub DatenHolen()
  Dim ExportDatei As Variant
  Dim WBQuelle As Workbook, WBZiel As Workbook
  Dim lngCalc As Long
  
  On Error GoTo ErrExit
  
  With Application
    .ScreenUpdating = False
    .EnableEvents = False
    lngCalc = .Calculation
    .Calculation = -4135
    .DisplayAlerts = False
  End With
  
  Set WBZiel = ThisWorkbook
  
  'DateiÖffnen Dialog anbieten
  ExportDatei = Application.GetOpenFilename("Micrsoft Excel-Dateien (*.xls),*.xls", , "Bitte die Datei xyz.xls öffnen ...")
  
  If ExportDatei <> CStr(False) Then
    
    'öffnen der ausgewählten Datei
    Set WBQuelle = Workbooks.Open(ExportDatei)
    
    With WBZiel
      WBQuelle.Sheets(Array("Zeiten", "Material", "Merkmale")).Copy After:=.Sheets(.Sheets.Count)
    End With
    
    WBQuelle.Close False
    
    Set WBZiel = Nothing
    Set WBQuelle = Nothing
    
    ErrExit:
    
    With Err
      If .Number <> 0 Then
        MsgBox "Fehler in Prozedur:" & vbTab & "'DatenHolen'" & vbLf & String(60, "_") & _
          vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
          "Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
          .Description & vbLf, vbExclamation + vbMsgBoxSetForeground, _
          "VBA - Fehler in Prozedur - DatenHolen"
        .Clear
      End If
    End With
    
  End If
  
  On Error GoTo 0
  
  With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = lngCalc
    .DisplayAlerts = True
    .StatusBar = False
  End With
  
End Sub


Gruß Sepp


Bild

Betrifft: AW: Korrektur
von: Marcel
Geschrieben am: 17.06.2015 08:25:17
Hallo Sepp
Perfekt, genau das habe ich gesucht.
Echt genial.
Vielen Dank für die schnelle Hilfe, freu mich gerade rieseig.
Grüsse
Marcel

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Tabellenblätter aus geschlossener Datei kopieren"