Indsæt de 2 følgende koder (Sub Flyt og Sub FjernDub) i et almindeligt kodemodul
- se hvordan ved klik på min hjemmeside under min profil.
Husk Projektmappen så skal gemmes med filtypen xlsm i stedet for med xlsx
Kodelinier som starter med Rem udføres ikke med mindre du fjerner "Rem"
Sub Flyt()
' De 2 følgende linier samt de 2 sidste kodelinier kan speede farten lidt op hvis du fjerner Rem
Rem Application.ScreenUpdating = False
Rem Application.Calculation = xlManual
Set sh1 = Sheets("VARELAGER"): Set sh2 = Sheets("DATA")
dato = Format(sh1.Range("H1"), "mm-dd-yyyy")
sh2.Select
rk = Cells(Rows.Count, "B").End(xlUp).Row: Rem antal rækker med data
ActiveSheet.Range("A1:E" & rk).AutoFilter Field:=2, Criteria1:=">" & dato, Operator:=xlAnd
Range("D2:E" & rk).Copy sh1.Range("A" & sh1.Cells(Rows.Count, "A").End(xlUp).Row + 1)
sh1.Range("H1") = Application.WorksheetFunction.Max(Range("B2:B" & rk)): Rem ny dato
ActiveSheet.ShowAllData
sh1.Select
'Linien herunder kører Subben FjernDub hvis du fjerner Rem, du kan også blot starte den selv til sidst
Rem Call FjernDub
Rem Application.Calculation = xlAutomatic
Rem Application.ScreenUpdating = False
End Sub
Sub FjernDub()
Sheets("VARELAGER").Select
rk = Cells(Rows.Count, "A").End(xlUp).Row
ActiveSheet.Range("A1:B" & rk).RemoveDuplicates Columns:=1, Header:=xlYes
End Sub