mit vba macro ändern?
28.04.2015 10:11:33
Thomas
Hallo,
erstmal besten Dank für dein Interesse.
Geht es womöglich mit vba besser?. das anliegende Macro macht so etwas ähnliches nur mit Datumswerten
Bekommt man dies so umgeschrieben das es mit Zahlwerten anstatt mit datumswerten funktioniert? Habe mich schon versucht aber ich schaffe es nicht.
liebe Grüsse Thomas
Public Sub prcCopyDatumsbereich()
Dim wksQuelle As Worksheet
Dim wksZiel As Worksheet
Dim Zeile_Z1 As Long, Zeile_Z As Long, Zeile_Q As Long, StatusCalc As Long
Dim rngCopy As Range
Dim varStart As Variant, varEnde As Variant, SpalteDatum As Long
With Application
.ScreenUpdating = False
StatusCalc = .Calculation
.Calculation = xlCalculationManual
End With
Set wksZiel = ActiveWorkbook.Worksheets(2) '2 ggf. durch Blattname in Anführungszeichen _
ersetzen
SpalteDatum = 4 'Spate D
With wksZiel
varStart = .Range("i1")
varEnde = .Range("i1")
Zeile_Z1 = Application.WorksheetFunction.Max(3, _
.Cells(.Rows.Count, SpalteDatum).End(xlUp).Row) + 1
Zeile_Z = Zeile_Z1 - 1
End With
Set wksQuelle = ActiveWorkbook.Worksheets(1) '1 ggf. durch Blattname in Anführungszeichen _
ersetzen
With wksQuelle
For Zeile_Q = 1 To .Cells(.Rows.Count, SpalteDatum).End(xlUp).Row
If IsDate(.Cells(Zeile_Q, SpalteDatum)) Then
If .Cells(Zeile_Q, SpalteDatum) >= varStart _
And .Cells(Zeile_Q, SpalteDatum) Zeile_Z1 Then
With wksZiel
.Range(.Rows(Zeile_Z1), .Rows(Zeile_Z)).Sort _
Key1:=.Cells(Zeile_Z1, SpalteDatum), order1:=xlAscending, Header:=xlNo
End With
End If
With Application
.ScreenUpdating = False
.Calculation = StatusCalc
End With
End Sub