AW: nach Datum selektieren
25.07.2012 10:48:15
UweD
Hallo
hier mal ein Makro:
Sub Liste()
On Error GoTo Fehler
Dim TB1, TB2, Datum As Date
Dim SP%, LR1&, LR2&, LRa&, LRd&, LRg&, i&
Set TB1 = Sheets("Anreisen")
Set TB2 = Sheets("Gästeliste")
SP = 1 'Spalte A
Datum = InputBox("welches Datum", "Gästeliste erzeugen", Format(Date, "dd.mm.yyyy"))
Application.ScreenUpdating = False
TB2.Range("G1").Value = Datum
LR2 = TB2.Cells.SpecialCells(xlCellTypeLastCell).Row
TB2.Range("A8:I" & LR2).ClearContents 'reset
With TB1
LR1 = .Cells(Rows.Count, SP).End(xlUp).Row 'letzte Zeile der Spalte
LRa = 8: LRd = 8: LRg = 8
For i = 2 To LR1
If .Cells(i, 3) = Datum Then 'Anreise
TB2.Cells(LRa, 1) = .Cells(i, 2)
TB2.Cells(LRa, 2) = .Cells(i, 5)
TB2.Cells(LRa, 3) = .Cells(i, 6)
LRa = LRa + 1
ElseIf .Cells(i, 4) = Datum Then 'Abreise
TB2.Cells(LRd, 4) = .Cells(i, 2)
TB2.Cells(LRd, 5) = .Cells(i, 5)
TB2.Cells(LRd, 6) = .Cells(i, 6)
LRd = LRd + 1
ElseIf .Cells(i, 3) Datum Then 'bleibt
TB2.Cells(LRg, 7) = .Cells(i, 2)
TB2.Cells(LRg, 8) = .Cells(i, 5)
TB2.Cells(LRg, 9) = .Cells(i, 6)
LRg = LRg + 1
End If
Next i
End With
Err.Clear 'nur bei XL 2007 benötigt
Fehler:
If Err.Number 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err.Clear
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub
Die Summen im Blatt über Formeln:
B6 : =SUMME(B8:B200;C8:C200)
E6 : =SUMME(E8:E200;F8:F200)
H6 : =SUMME(H8:H200;I8:I200)
Gruß UweD