Forum Discussion

Michelle365's avatar
Michelle365
Copper Contributor
Aug 13, 2021
Solved

Moving Rows to different sheets based on future dates.

I have created a form for several people to enter scheduling requests.  I need a macro to move rows from the form sheet to different sheets based on the date of the schedule request without needing t...
  • HansVogelaar's avatar
    Aug 13, 2021

    Michelle365 

    Try this:

    Sub MoveRows()
        Dim ws As Worksheet
        Dim wt As Worksheet
        Dim tbl As ListObject
        Dim n As String
        Dim r As ListRow
        Dim m As Long
        Dim t As Long
        Application.ScreenUpdating = False
        Set ws = Worksheets("Form1")
        Set tbl = ws.ListObjects(1)
        For Each r In tbl.ListRows
            n = Format(r.Range(1, 1).Value, "dddd, mmmm d, yyyy")
            Set wt = Nothing
            On Error Resume Next
            Set wt = Worksheets(n)
            On Error GoTo 0
            If wt Is Nothing Then
                Set wt = Worksheets.Add(After:=Worksheets(Worksheets.Count))
                wt.Name = n
                tbl.HeaderRowRange.Copy Destination:=wt.Range("A1")
            End If
            t = wt.Range("A" & wt.Rows.Count).End(xlUp).Row + 1
            r.Range.Copy Destination:=wt.Range("A" & t)
        Next r
        tbl.DataBodyRange.Delete
        Application.CutCopyMode = False
        Application.ScreenUpdating = True
    End Sub

Resources