AW: Nochmalige Nachfrage wegen Code
15.04.2012 20:54:41
fcs
Hallo Erwin,
du muss eine zusätzliche Prüfung einbauen, in der die Zelle in den Spalten auf Datum geprüft werden.
Für die Einfügezeile im Zielblatt kann man die Startzeile setzen und dann immer um 1 erhöhen.
In deiner auskommentierten Sortieranweisung waren Fehlerquellen eingebaut.
Gruß
Franz
Sub aktive_MA_einlesen()
Dim wksQuelle As Worksheet
Dim wksZiel As Worksheet
Dim RnG As Range, loletzte&, MyCol&
On Error GoTo ErrScreen
Set wksQuelle = Worksheets("Mitarbeiter")
Set wksZiel = Worksheets("Termine")
Application.ScreenUpdating = False
'Zielbereich leeren - Ende evtl. anpassen
With wksZiel
loletzte = .Cells(.Rows.Count, 2).End(xlUp).Row
If loletzte >= 2 Then
.Range(.Cells(2, 1), .Cells(loletzte, 4)).ClearContents
End If
loletzte = 1 'Zeile unterhalb der die Daten eingetragen werden sollen
End With
With wksQuelle
For Each RnG In .Range(.Cells(5, 6), .Cells(.Rows.Count, 6).End(xlUp))
If RnG = "A" Then
'hier Spaltenschleife wg. Datum von Spalte ... bis Spalte ....
For MyCol = 16 To 28
If IsDate(.Cells(RnG.Row, MyCol)) Then
If CDate(.Cells(RnG.Row, MyCol).Text) >= Date Then
loletzte = loletzte + 1
If loletzte > wksZiel.Rows.Count Then
MsgBox "Zieltabelle ist voll", vbInformation + vbOKOnly, _
"Makro - aktive_MA_einlesen"
GoTo ErrScreen
End If
wksZiel.Cells(loletzte, 1) = CDate(.Cells(RnG.Row, MyCol).Text)
wksZiel.Cells(loletzte, 2) = .Cells(RnG.Row, 2)
wksZiel.Cells(loletzte, 3) = .Cells(RnG.Row, 3)
wksZiel.Cells(loletzte, 4) = .Cells(4, MyCol)
End If
End If
Next
End If
Next
End With
With wksZiel
.Columns(4).WrapText = False 'Umbruch entfernen
'1.nach Datum sortieren - 2.nach Name sortieren
With .Range(.Cells(1, 1), .Cells(loletzte, 4))
.Sort Key1:=.Range("A1"), Order1:=xlAscending, _
Key2:=.Range("B1"), Order2:=xlAscending, Header:=xlYes
End With
.Activate
End With
ErrScreen:
Application.ScreenUpdating = True
End Sub