ich hätte gerne Hilfe zu meiner Aufgabe
es geht um das kopieren von einem variablen Bereich von Blatt Daten auf Blatt Auswertung
genauere Beschreibung in der Datei
https://www.herber.de/bbs/user/58797.xls
Bitte um Hilfe und Gruß
Robert
Sub Test()
Dim Bereich As Range
Dim DatumVon As String
Dim DatumBis As String
DatumVon = CDbl(CDate("01.01.2009 00:00"))
DatumBis = CDbl(CDate("01.01.2009 23:59:59"))
DatumVon = Replace(DatumVon, ",", ".")
DatumBis = Replace(DatumBis, ",", ".")
With Application
.ScreenUpdating = False
With Sheets("Daten")
Set Bereich = .Range("M2", .Cells(.Rows.Count, 13).End(xlUp))
Set Bereich = Bereich.Offset(0, .Columns.Count - Bereich.Column)
Bereich.FormulaR1C1 = "=IF(AND(RC13>=" & DatumVon & ",RC13<=" & DatumBis & "),0,"""")"
With Sheets("Auswertung")
.Range("A2", .UsedRange.Cells(.UsedRange.Cells.Count)).Value = ""
Bereich.SpecialCells(xlCellTypeFormulas, 1).EntireRow.Copy .Range("A2")
.Columns(.Columns.Count).Delete
End With
.Columns(.Columns.Count).Delete
End With
.ScreenUpdating = True
End With
End Sub
Gruß Tino
Sub Test()
Dim Bereich As Range
Dim DatumVon As String
Dim DatumBis As String
With Application
.ScreenUpdating = False
With Sheets("Daten")
DatumVon = CDbl(CDate(.Range("W1")))
DatumBis = CDbl(CDate(.Range("W2")))
DatumVon = Replace(DatumVon, ",", ".")
DatumBis = Replace(DatumBis, ",", ".")
Set Bereich = .Range("M2", .Cells(.Rows.Count, 13).End(xlUp))
Set Bereich = Bereich.Offset(0, .Columns.Count - Bereich.Column)
Bereich.FormulaR1C1 = "=IF(AND(RC13>=" & DatumVon & ",RC13<=" & DatumBis & "),0,"""")"
With Sheets("Auswertung")
.Range("A1", .UsedRange.Cells(.UsedRange.Cells.Count)).Value = ""
Sheets("Daten").Range("A1:N1").Copy .Range("A1")
Bereich.SpecialCells(xlCellTypeFormulas, 1).EntireRow.Copy .Range("A2")
.Columns(.Columns.Count).Delete
.Columns(1).Insert xlToRight, xlFormatFromLeftOrAbove
.Range("W1:W2").Delete
End With
.Columns(.Columns.Count).Delete
End With
.ScreenUpdating = True
End With
End Sub
Vielleicht wenn ich nachher noch Lust habe, baue ich dies etwas um.
Gruß Tino
Sub Test2()
Dim Bereich As Range, BereichFilter As Range
Dim DatumVon As String
Dim DatumBis As String
With Application
.ScreenUpdating = False
.EnableEvents = False
With Sheets("Daten")
DatumVon = CDbl(CDate(.Range("W1")))
DatumBis = CDbl(CDate(.Range("W2")))
DatumVon = Replace(DatumVon, ",", ".")
DatumBis = Replace(DatumBis, ",", ".")
Set Bereich = .Range("M1", .Cells(.Rows.Count, 13).End(xlUp))
Bereich.AutoFilter 1, ">=" & DatumVon, xlAnd, "<=" & DatumBis, False
Set BereichFilter = .Range("A2", .UsedRange.Cells(.UsedRange.Cells.Count)).SpecialCells(xlCellTypeVisible)
With Sheets("Auswertung")
.Range("B2", .UsedRange.Cells(.UsedRange.Cells.Count)).Value = ""
BereichFilter.Copy .Range("B2")
Bereich.AutoFilter
End With
End With
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Gruß Tino