Hello I would like to find a macro that
Find Rows with specific ColumnValue Copy the hole Row to another sheet and then delete the row from the original sheet.
I have one Code but it dosent work when there is the Rows to copy are seperated from eachother.
Sub Arkivera_Klara()
ActiveSheet.Unprotect
Dim ws As Worksheet
Dim lr As Long 'last row with data (based on column A)
Dim lc As Long 'last column with data (based on row 1)
Set ws = Worksheets("FVO SLU Lab")
lr = ws.Range("A" & Rows.Count).End(xlUp).Row
lc = ws.Cells(4, Columns.Count).End(xlToLeft).Column
'ws.Rows(1).Insert
Application.ScreenUpdating = False
With ws.Range(ws.Cells(5, 1), ws.Cells(lr, lc))
.AutoFilter Field:=8, Criteria1:="Klar"
.SpecialCells(xlCellTypeVisible).EntireRow.Copy
End With
Sheets("Avslutade").Activate
Rows("6:6").Activate
Selection.Insert Shift:=xlDown
With ws.Range(ws.Cells(5, 1), ws.Cells(lr, lc))
.AutoFilter Field:=8, Criteria1:="Klar"
.SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
ws.AutoFilterMode = False
ActiveSheet.Protect
Application.ScreenUpdating = True
End Sub
Bookmarks