Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender

Forumthread: Datum in neue Spalte kopieren

Datum in neue Spalte kopieren
21.06.2017 16:57:54
Horst
Hallo,
ich bräuchte bitte eine Hilfe bei einem Makroproblem.
Ich habe in einer Spalte B einmal ein Datum, dann darunter Mitarbeiter. Dann eine Leerzeile. Dann kommt das nächste Dat um und wieder die Mitarbeiter.
Ich hätte nun gerne per Makro folgendes gelöst:
Schreibe das Datum in die noch leere Spalte A vom ersten Mitarbeiter bis zum letzten Mitarbeiter in diesem Bereich, dann wiederhole diese Schritte solange, bis in Spalte B kein Mitarbeiter mehr steht.
Beispiel
Spalte B
1.3.2017
Mitarbeiter A
Mitarbeiter B
Mitarbeiter C
1.2.2017
Mitarbeiter A
Mitarbeiter B
Mitarbeiter C
1.1.2017
Mitarbeiter A
Mitarbeiter B
Mitarbeiter C
Aussehen sollte es dann so:
Spalte A Spalte B
1.3.2017 Mitarbeiter A
1.3.2017 Mitarbeiter B
1.3.2017 Mitarbeiter C
1.2.2017 Mitarbeiter A
1.2.2017 Mitarbeiter B
1.2.2017 Mitarbeiter C
1.1.2017 Mitarbeiter A
1.1.2017 Mitarbeiter B
1.1.2017 Mitarbeiter C
Bitte um eure Unterstützung!
Vielen Dank!
Anzeige

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Datum in neue Spalte kopieren
21.06.2017 17:30:56
UweD
Hallo
so?
Sub MA()
On Error GoTo Fehler
Dim Datum As Date, i As Double
Dim LR As Double
With Sheets("Tabelle1")
LR = .Cells(.Rows.Count, "B").End(xlUp).Row 'letzte Zeile der Spalte
For i = 1 To LR
If IsDate(.Cells(i, 2)) Then
Datum = .Cells(i, 2)
.Cells(i, 2).ClearContents
ElseIf .Cells(i, 2)  "" Then
.Cells(i, 1) = Datum
End If
Next
With .Sort
.SortFields.Clear
.SortFields.Add Key:=Range("A1"), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortTextAsNumbers
.SetRange Range("A1:B" & LR)
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
'*** Fehlerbehandlung
Err.Clear
On Error GoTo Fehler
Fehler:
If Err.Number  0 Then MsgBox "Fehler: " & _
Err.Number & vbLf & Err.Description: Err.Clear
End Sub

LG UweD
Anzeige
;

Forumthreads zu verwandten Themen

Anzeige
Anzeige
Anzeige
Anzeige
Entdecke relevante Threads

Schau dir verwandte Threads basierend auf dem aktuellen Thema an

Alle relevanten Threads mit Inhaltsvorschau entdecken
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige