Kann mir jemand sagen wie ich den wegbekomme
Kann mir jemand sagen wie ich den wegbekomme
Sub verschiebenInKW4()
'Einblenden von Spalten
Sheets("KW4").Select ''''''''''''''''''''''''''''
Columns("A:AG").Select
Selection.EntireColumn.Hidden = False
Sheets("R2").Select
Columns("A:AG").Select
Selection.EntireColumn.Hidden = False
'Code
Dim TB2, LR1 As Long, LR2 As Long
Set TB2 = Sheets("R2")
LR2 = TB2.Cells(TB2.Rows.Count, "A").End(xlUp).Row + 1
Application.ScreenUpdating = False
With Sheets("KW4") ''''''''''''''''''''''''''''''''''''''''''
LR1 = .Cells(.Rows.Count, "A").End(xlUp).Row
If WorksheetFunction.CountA(.Range("AG2:AG" & LR1)) = 0 Then
MsgBox "Keine Eingabe!"
Exit Sub
End If
If .AutoFilterMode Then .AutoFilterMode = False ' Autofilter ausschalten
.Range("A1:AG" & LR1).AutoFilter Field:=1, Criteria1:="""""", Operator:=xlAnd
.Range("A1:AG" & LR1).AutoFilter Field:=33, Criteria1:=""
'.Range("A2:AG" & LR1).Copy TB2.Range("A" & LR2) 'Zielzelle
.Range("A2:AG" & LR1).Copy
TB2.Range("A" & LR2).PasteSpecial xlPasteAll
Application.CutCopyMode = False
.Range("A2:AG" & LR1).EntireRow.Delete xlUp '?
.AutoFilterMode = False
TB2.UsedRange.Value = TB2.UsedRange.Value 'ggf Formeln raus
End With
With TB2
LR2 = .Cells(.Rows.Count, "A").End(xlUp).Row
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=.Range("AG2:AG" & LR2) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=.Range("AG2:AG" & LR2) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'sortierung _
Spalte Lagerplatz
.Sort.SetRange .Range("A2:AG" & LR2)
.Sort.Header = xlYes
.Sort.MatchCase = False
.Sort.Orientation = xlTopToBottom
.Sort.SortMethod = xlPinYin
.Sort.Apply
End With
Application.ScreenUpdating = True
'ausblenden von Spalten
Sheets("R2").Select
Columns("M:AD").Select
Range("AD1").Activate
Selection.EntireColumn.Hidden = True
Columns("J:J").Select
Selection.EntireColumn.Hidden = True
Columns("D:D").Select
Selection.EntireColumn.Hidden = True
Sheets("KW4").Select ''''''''''''''''''''''''''''''''''''
Columns("D:D").Select
Selection.EntireColumn.Hidden = True
Columns("J:J").Select
Selection.EntireColumn.Hidden = True
Columns("M:AD").Select
Selection.EntireColumn.Hidden = True
End Sub