Dateiauswahldiaglog
27.06.2017 09:44:31
Basti
bei diesem Fall stoße meine VBA-Skills an ihre Grenzen.
Mit dem u.a. Makro verschiebe ich bestimmte Zellen der aktuell markierten Zeile in eine festgelegte Arbeitsmappe.
Ich würde gerne den Code so ändern, dass ich über den Dateiauswahldialog die Arbeitsmappe wählen kann ohne jedes Mal den Dateipfad in das Makro kopieren zu müssen.
Vielen Dank für Eure Hilfe.
Gruß
Basti
Public Sub NewIssue()
Dim objXLApp As Excel.Application
Dim objXLABC As Excel.Workbook
Dim objXLWorkbooks As Excel.Workbooks
Dim neuWkb
Dim lngLastRow As Long
Dim rng As Range
Dim I As Long
Dim rr As Long
Dim zells As Range
rr = Selection.Row
Set rng = Range("A1,B1,C1,D1,E1,F1,G1,H1,I1,J1").Offset(rr - 1)
Set objXLApp = New Excel.Application
Set objXLWorkbooks = objXLApp.Workbooks
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set objXLABC = objXLWorkbooks.Open("C:\Users\UserName\Desktop\Arbeitsmappe.xlsx")
neuWkb = objXLABC.Name
With objXLWorkbooks(neuWkb).Sheets(1)
lngLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
If lngLastRow = 1 Then
Laufendezahl = 1
Else
Laufendezahl = .Cells(lngLastRow, 1) + 1
End If
.Cells(lngLastRow + 1, 1) = Laufendezahl
.Cells(lngLastRow + 1, 2) = Application.UserName
.Cells(lngLastRow + 1, 3) = Now
I = 3
For Each zell In rng
I = I + 1
.Cells(lngLastRow + 1, I) = zell
Next
End With
objXLWorkbooks(neuWkb).Close savechanges:=True
Workbooks.Open ("C:\Users\UserName\Desktop\Arbeitsmappe.xlsx")
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
Set objXLApp = Nothing
Set objXLWorkbooks = Nothing
End Sub