Worksheet Consolidation Macro

[ctindell]

I have a workbook that has a worksheet containing "Incidents" and "CLOSED" incidents. I need a macro that moves(cuts) all of the "CLOSED" incidents (rows) from the "Incidents" worksheet to the "Closed Incidents" worksheet. This will be updated monthly.

The code I have copies all of the information. I thought about filtering the column that contains the status however it did not work. Here is the code:

Sub MoveClosedIncidents()
Dim SourceRange As Range, DestRange As Range
Dim DestSheet As Worksheet, Lr As Long
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Const shtSource = "Incidents"
Const shtDest = "CLOSED Incidents"

Set SourceRange = Sheets("Incidents").Range("A2:P50000")

Set DestSheet = Sheets("CLOSED Incidents")
Lr = lastrow(DestSheet)

Set DestRange = DestSheet.Range("A" & Lr + 1)

Sheets("Incidents").Activate

DeleteBlankRows (this sub is for deleting any blank rows that might exist between rows)

SourceRange.Copy DestRange
With Application
.ScreenUpdating = True
.EnableEvents = True
End With

End Sub


Column M contains the status which will be the filtered column. Any help/hints are appreciated.

 

[Domenic]

Assuming that Row 1 contains the column headers, try...

[font=Verdana][color=darkblue]Option[/color] [color=darkblue]Explicit[/color]

[color=darkblue]Sub[/color] MoveClosedIncidents()

    [color=darkblue]Dim[/color] wksSource [color=darkblue]As[/color] Worksheet
    [color=darkblue]Dim[/color] wksDest [color=darkblue]As[/color] Worksheet
    
    [color=darkblue]With[/color] Application
        .ScreenUpdating = [color=darkblue]False[/color]
        .EnableEvents = [color=darkblue]False[/color]
    [color=darkblue]End[/color] [color=darkblue]With[/color]

    [color=darkblue]Const[/color] SearchTerm [color=darkblue]As[/color] [color=darkblue]String[/color] = "CLOSED"

    [color=darkblue]Set[/color] wksSource = Sheets("Incidents")
    
    [color=darkblue]Set[/color] wksDest = Sheets("CLOSED Incidents")
    
    [color=darkblue]With[/color] wksSource.UsedRange
        .AutoFilter field:=13, Criteria1:=SearchTerm
        .Offset(1, 0).Copy wksDest.Cells(wksDest.Rows.Count, "A").End(xlUp)(2)
        .Offset(1, 0).EntireRow.Delete
        .AutoFilter
    [color=darkblue]End[/color] [color=darkblue]With[/color]
    
    [color=darkblue]With[/color] Application
        .ScreenUpdating = [color=darkblue]True[/color]
        .EnableEvents = [color=darkblue]True[/color]
    [color=darkblue]End[/color] [color=darkblue]With[/color]
    
    MsgBox "Completed...", vbInformation [color=green]'Optional[/color]
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]
[/font]

 

[ctindell]

This works, thanks Dom; I started to use a different code however if a closed item was last on the list it would remain on the "incident" worksheet. Your version works perfectly!!

 

[Domenic]

You're welcome! Thanks for the feedback!