Anpassung Import-Code
12.02.2016 10:23:38
Bernd
der nachfolgende Code kopiert den Bereich eines Tabellenblattes aus einer Datei in dein vorgebenenes Tabellenblatt einer anderen Datei. Nun würde ich gerne den Code in der Form erweitern, dass die Quelldatei und die Zieldatei zwar unverändert sind, mim aber mehrere Tabellenblätter mit jeweils eigenem vorgegebenem Bereich analog kopiert werden. Kann mir da jemand helfen?
Bernd
PS:
Hier ist der bisherige Code für eine Tabelle:
Sub DatenImportieren()
Dim wkbQuelle As Workbook, wksQuelle As Worksheet, varQuelle As Variant
Dim wkbZiel As Workbook, wksZiel As Worksheet
On Error GoTo Fehler
Set wkbZiel = ActiveWorkbook
With Application.FileDialog(msoFileDialogOpen)
.Title = "Bitte die Datei mit den Quelldaten auswählen"
Application.ScreenUpdating = False
If .Show = -1 Then
varQuelle = .SelectedItems(1)
Set wkbQuelle = Application.Workbooks.Open(varQuelle, ReadOnly:=True)
Set wksQuelle = wkbQuelle.Worksheets("Quelle1")
Set wksZiel = wkbZiel.Worksheets("Ziel1")
With wksZiel.Range("A1:H75")
.ClearContents
.ClearFormats
End With
wksQuelle.Range("A1:H75").Copy
With wksZiel.Range("A1")
'.PasteSpecial Paste:=xlPasteFormats
.PasteSpecial Paste:=xlPasteValues
End With
Application.CutCopyMode = False
wkbQuelle.Close savechanges:=False
Set wkbQuelle = Nothing
End If
End With
Fehler:
Application.ScreenUpdating = True
With Err
Select Case .Number
Case 0 'alles OK
Case 9
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description & vbLf & vbLf _
& "Tabelle ist in Datei nicht vorhanden", vbOKOnly, "Fehlerprüfung"
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description, _
vbOKOnly, "Fehlerprüfung"
End Select
End With
If Not wkbQuelle Is Nothing Then wkbQuelle.Close savechanges:=False
End Sub