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
Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen