Hallo Katrin,
hier mal das ganze Makro.
Sub test()
Dim dteStart As Date, dteEnde As Date, i As Integer, j As Integer, arr, lngRow As Long, lngrow2 As Long
arr = Array(12, 4, 5, 7, 9, 15, 2)
Application.ScreenUpdating = False
With Sheets("Lagerbewegungen")
dteStart = .Cells(4, 3)
dteEnde = .Cells(4, 4)
End With
With Sheets("Übersicht")
.Columns("A:Q").AutoFilter Field:=12, Operator:=xlFilterValues, Criteria1:=">=" & CLng(dteStart), Criteria2:="<=" & CLng(dteEnde)
lngRow = .Cells(.Rows.Count, 12).End(xlUp).Row
lngrow2 = Sheets("Lagerbewegungen").Cells(Rows.Count, 1).End(xlUp).Row + 1
For i = LBound(arr) To UBound(arr)
If i = UBound(arr) Then
.Range(.Cells(2, arr(i)), .Cells(lngRow, arr(i))).SpecialCells(xlVisible).Copy Sheets("Lagerbewegungen").Cells(lngrow2, 13)
Else
.Range(.Cells(2, arr(i)), .Cells(lngRow, arr(i))).SpecialCells(xlVisible).Copy Sheets("Lagerbewegungen").Cells(lngrow2, i + 1)
End If
Next i
.Columns("A:Q").AutoFilter Field:=12
End With
With Sheets("Erledigt")
For j = 12 To 13
.Columns("A:Q").AutoFilter Field:=j, Operator:=xlFilterValues, Criteria1:=">=" & CLng(dteStart), Criteria2:="<=" & CLng(dteEnde)
lngRow = .Cells(.Rows.Count, j).End(xlUp).Row
If lngRow > 1 Then
lngrow2 = Sheets("Lagerbewegungen").Cells(Rows.Count, 1).End(xlUp).Row + 1
.Range(.Cells(2, j), .Cells(lngRow, j)).SpecialCells(xlVisible).Copy Sheets("Lagerbewegungen").Cells(lngrow2, (j - 12) * 6 + 1)
For i = LBound(arr) + 1 To UBound(arr)
If i = UBound(arr) Then
.Range(.Cells(2, arr(i)), .Cells(lngRow, arr(i))).SpecialCells(xlVisible).Copy Sheets("Lagerbewegungen").Cells(lngrow2, 13)
Else
.Range(.Cells(2, arr(i)), .Cells(lngRow, arr(i))).SpecialCells(xlVisible).Copy Sheets("Lagerbewegungen").Cells(lngrow2, (j - 12) * 6 + 1 + i)
End If
Next i
End If
.Columns("A:Q").AutoFilter Field:=j
Next j
End With
With Sheets("Lagerbewegungen")
lngRow = .Cells(.Rows.Count, 7).End(xlUp).Row
.Range(.Cells(7, 14), .Cells(lngRow, 14)).FormulaR1C1 = "=IF(RC[-13]="""",RC[-7],RC[-13])"
.Range(.Cells(7, 1), .Cells(lngRow, 14)).Sort _
Key1:=.Cells(7, 14), Order1:=xlAscending, DataOption1:=xlSortNormal, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
.Range(.Cells(7, 14), .Cells(lngRow, 14)).ClearContents
.Range(.Cells(6, 1), .Cells(lngRow, 13)).AutoFilter Field:=13, Operator:=xlFilterValues, Criteria1:="DMG"
End With
End Sub
Gruß
Florian
