Werte suchen und markieren
29.02.2020 21:19:53
Oliver
seit Tagen zerbreche ich mir den Kopf über folgendes Problem:
Ich würde gerne die Zeiten von unserer Stempeluhr die automatisch in eine Excel- Datei kopiert werden (durch Makro von Firma wo wir die Stempeluhr gekauft haben - die Datei ist schreibgeschützt und das Kennwort ist nicht bekannt) in eine von mir erstellte Excel Datei überschreiben. Problem an der ganzen Geschichte ist, dass die Tabelle der Stempeluhr fortlaufend beschrieben wird und irrelevante Zeilen ausgeblendet werden. So steht zum Beispiel der 01.12.2019 in der Zeile B1164. - Bei jedem Mitarbeiter ist der erste Wochentag in einer anderen Zeile... Ich muss also in der Spalte B nach dem ersten Tag des gewünschten Monats suchen, dann den letzen des Monats finden - den Bereich neben dem Datum wo die Kommen- und Gehen- Zeiten eingetragen sind (z.B. C1164: D1195 ) markieren und kopieren.
Ich habe folgendes Programm dazu geschrieben, aber ich bekomme es einfach nicht zum laufen.
Entweder habe ich den Laufzeitfehler '91, oder er springt nicht in den True Teil der IF Anweisung...
Sub DatumFinden ()
'variablen Deklaration
Dim ErsterTag As String
Dim LetzerTag As String
Dim rngCell As Range
Dim x As Range
Dim y As Range
Dim wsKopieren As Worksheet
Dim wsEinfügen As Worksheet
'Programm
ErsterTag = "01.12.2019" 'Wird eigentlich über UserFace eingetragen
LetzerTag = "31.12.2019" 'Wird eigentlich über UserFace eingetragen
Set wsKopieren = Workbooks("Zeitmaske.xlsm").Worksheets("Dezember,2019")
Set wsEinfügen = Workbooks("Mappe1").Worksheets("Tabelle1")
Set rngCell = Workbooks("Zeitmaske.xlsm").Worksheets("Dezember,2019").Columns(1).Find( _
ErsterTag, lookat:=xlWhole, LookIn:=xlValues, MatchCase:=True)
If Not rngCell Is Nothing Then
y = rngCell.Offset(0, 1).Column
Else
MsgBox "Name not Found"
End If
Set rngCell = Workbooks("Zeitmaske.xlsm").Worksheets("Dezember,2019").Columns(1).Find( _
LetzerTag, lookat:=xlWhole, LookIn:=xlValues, MatchCase:=True)
If Not rngCell Is Nothing Then
x = rngCell.Offset(0, 2).Row
Else
MsgBox "No Date"
End If
wsKopieren.Range(x & y).Copy
wsEinfügen.Range("B7").PasteSpecial Paste:=xlPasteValues
End Sub
LG Oliver
Anzeige