'Code für Userform
Option Explicit
Private strDateiAktuell As String
Private strDateiArbeit As String
Private Sub CommandButton1_Click()
'aktuelle Datei auswählen
With Application.FileDialog(msoFileDialogOpen)
.Title = "Bitte aktuelle Datei auswählen"
.ButtonName = "Auswählen"
.FilterIndex = 2
If .Show = -1 Then
strDateiAktuell = .SelectedItems(1)
Me.Label2.Caption = strDateiAktuell
Else
strDateiAktuell = ""
Me.Label2.Caption = "keine aktuelle Datei gewählt"
End If
End With
End Sub
Private Sub CommandButton2_Click()
'Arbeitsdatei auswählen
With Application.FileDialog(msoFileDialogOpen)
.Title = "Bitte Arbeitsatei auswählen"
.ButtonName = "Auswählen"
.FilterIndex = 2
If .Show = -1 Then
strDateiArbeit = .SelectedItems(1)
Me.Label1.Caption = strDateiArbeit
Else
strDateiArbeit = ""
Me.Label1.Caption = "keine Arbeitsdatei gewählt"
End If
End With
End Sub
Private Sub CommandButton3_Click()
'Daten nicht importieren
Unload Me
End Sub
Private Sub CommandButton4_Click()
'Daten importieren
Dim wbkZiel As Workbook, wbkQuelle As Workbook, rngQuelle As Range
Dim wksZiel As Worksheet, wksQuelle As Worksheet
If strDateiArbeit = "" Or strDateiAktuell = "" Then
MsgBox "Es wurde keine ""Arbeitsdatei""" & vbLf _
& "oder" & vbLf _
& "keine ""Aktuelle Datei"" ausgewählt!"
Exit Sub
End If
Application.ScreenUpdating = False
Set wbkZiel = ActiveWorkbook
Set wksZiel = wbkZiel.Worksheets("Arbeitsdatei")
Set wbkQuelle = Application.Workbooks.Open(Filename:=strDateiArbeit, _
UpdateLinks:=False, ReadOnly:=True)
Set wksQuelle = wbkQuelle.Worksheets(1)
Set rngQuelle = wksQuelle.UsedRange
wksZiel.UsedRange.Clear
rngQuelle.Copy Destination:=wksZiel.Range(rngQuelle.Address)
wbkQuelle.Close savechanges:=False
Set wksZiel = wbkZiel.Worksheets("Aktuelle Datei")
Set wbkQuelle = Application.Workbooks.Open(Filename:=strDateiAktuell, _
UpdateLinks:=False, ReadOnly:=True)
Set wksQuelle = wbkQuelle.Worksheets(1)
Set rngQuelle = wksQuelle.UsedRange
wksZiel.UsedRange.Clear
rngQuelle.Copy Destination:=wksZiel.Range(rngQuelle.Address)
wbkQuelle.Close savechanges:=False
Set wbkZiel = Nothing: Set wbkQuelle = Nothing
Set rngQuelle = Nothing: Set wksZiel = Nothing: Set wksQuelle = Nothing
Application.ScreenUpdating = True
Unload Me
MsgBox "Import abgeschlossen"
End Sub