AW: Bestehende Formel soll nicht von Makro
19.10.2017 12:53:55
Makro
Hi Rudi,
das tut mir leid! Hier wäre mein Makro als Text:
Option Explicit
Dim wkb As Workbook
Dim wksdata As Worksheet
Dim wksDest As Worksheet
Dim wkbData As Workbook
Sub Update_Button()
Dim llastr As Long
Dim ilasts As Integer
Dim z As Long
Dim s As Integer
Dim llastdest As Long
Dim Pfad As String
Dim Dateiname As String
Dim iRow As Long
Pfad = "C:\Users\feigeral\Desktop\Hours Booking\" 'Pfad, unter welchem die Stundenlisten _
liegen
Dateiname = Dir(Pfad & "*.xlsm")
Initialisiere 'Funktion Initialisiere siehe unten
wksDest.UsedRange.Offset(1, 0).Value = ""
Do While Dateiname "" 'mittels While Schleife werden Stundenlisten durchlaufen
Set wkbData = Workbooks.Open(Filename:=Pfad & Dateiname)
Set wksdata = wkbData.Sheets("Hours")
llastr = BestimmeLetzteZeile(wksdata, 2) 'letzte Zeile erstellen
ilasts = BestimmeLetzteSpalte(wksdata, 2) 'letzte Spalte bestimmen
llastdest = BestimmeLetzteZeile(wksDest, 1) + 1
For z = 5 To llastr 'Alle Zeilen ab Zeile 5 werden durchlaufen
For s = 3 To ilasts 'Alle Spalten ab Spalte C werden durchlaufen
If wksdata.Cells(z, s).Value "" Then
'Zeile kopieren und anschließender Übergang zur nächsten Stundenliste
wksDest.Cells(llastdest, 1).Value = wksdata.Cells(2, s).Value 'Belegdatum
wksDest.Cells(llastdest, 2).Value = wksdata.Cells(2, s).Value ' _
Buchungsdatum
wksDest.Cells(llastdest, 3).Value = wksdata.Cells(1, 1).Value ' _
Kostenstelle
wksDest.Cells(llastdest, 4).Value = wksdata.Cells(1, 3).Value ' _
Leistungsart
wksDest.Cells(llastdest, 6).Value = wksdata.Cells(z, 2).Value 'Projektname
wksDest.Cells(llastdest, 7).Value = wksdata.Cells(z, s).Value 'Menge
wksDest.Cells(llastdest, 8).Value = "H" 'ME
wksDest.Cells(llastdest, 9).Value = wksdata.Cells(1, 2).Value ' _
Personalnummer
llastdest = llastdest + 1
End If
Next s
Next z
wkbData.Close False
Set wksdata = Nothing
Set wkbData = Nothing
Dateiname = Dir() 'automatisches Auswählen der nächsten Datei
Loop
End Sub
Function BestimmeLetzteZeile(ByVal wks As Worksheet, ByVal s As Integer) As Long
BestimmeLetzteZeile = wks.Cells(wks.Rows.Count, s).End(xlUp).Row
End Function
Function BestimmeLetzteSpalte(ByVal wks As Worksheet, ByVal z As Long) As Integer
If wks.Cells(z, 1).Value "" Then
BestimmeLetzteSpalte = wks.Cells(z, wks.Columns.Count).End(xlToLeft).Column
Else
BestimmeLetzteSpalte = 1
End If
End Function
Function Initialisiere()
If wkb Is Nothing Then
Set wkb = ThisWorkbook
Set wksDest = wkb.Sheets("Tabelle1")
End If
End Function
Wie muss ich das genau umschreiben? Kannst du mir das sagen?