Private Sub cmbAktZBearbeiten_Click()
Const c_sPath As String = "H:\My Documents\###Bachelorthesis\TEST_Speicherort\"
Dim BearbZ As String
Dim wkbQuelle As Excel.Workbook
Dim wksQuelle As Excel.Worksheet
Dim wkbSenke As Excel.Workbook
Dim wksSenke As Excel.Worksheet
BearbZ = InputBox("Bitte Aktenzeichen der zu bearbeitenden Datei eingeben.")
If StrPtr(BearbZ) = 0 Then Exit Sub
If BearbZ = "" Then
MsgBox "Bitte ein Aktenzeichen eingeben!"
Else
If Dir(c_sPath & BearbZ & ".xls") = "" Then
MsgBox "Datei mit diesem Aktenzeichen nicht vorhanden."
Else
Set wkbQuelle = ThisWorkbook
Set wkbSenke = Workbooks.Open(c_sPath & BearbZ & ".xls")
Set wksQuelle = wkbQuelle.Sheets("Status")
Set wksSenke = wkbSenke.Sheets("Status")
wksQuelle.Range("E1:H1").Copy Destination:=wksSenke.Range("E1:H1")
wksQuelle.Range("D5:H9").Copy Destination:=wksSenke.Range("D5:H9")
wksQuelle.Range("D22:H29").Copy Destination:=wksSenke.Range("D22:H29")
Set wksQuelle = wkbQuelle.Sheets("Markt")
Set wksSenke = wkbSenke.Sheets("Markt")
wksQuelle.Range("E1:H1").Copy Destination:=wksSenke.Range("E1:H1")
wksQuelle.Range("D4:H10").Copy Destination:=wksSenke.Range("D4:H10")
wksQuelle.Range("D13:H17").Copy Destination:=wksSenke.Range("D13:H17")
Set wksQuelle = wkbQuelle.Sheets("Wert")
Set wksSenke = wkbSenke.Sheets("Wert")
wksQuelle.Range("E1:H1").Copy Destination:=wksSenke.Range("E1:H1")
wksQuelle.Range("D4:H8").Copy Destination:=wksSenke.Range("D4:H8")
wksQuelle.Range("D11:H15").Copy Destination:=wksSenke.Range("D11:H15")
wkbSenke.Close SaveChanges:=True
Set wksSenke = Nothing
Set wkbSenke = Nothing
Set wksQuelle = Nothing
Set wkbQuelle = Nothing
End If
End If
End Sub