Sub move2Shts()
'https://www.mrexcel.com/board/threads/moves-rows-to-sheets.1215896/
Dim CellValue As Range
Dim CUnique As New Collection
Dim VUnique As Variant
Dim ws As Worksheet
Dim LastRow As Long
Dim DestRows As Long
LastRow = Sheets("TR Retail - 2022 - GLTrans").Range("D" & Rows.Count).End(xlUp).Row
'get list of unique value in D. You can't have two items with the same name in a collection,
'so when it errors due to a duplicate name, we just go to the next value
On Error Resume Next
'Adding unique items to collection from defined range
For Each CellValue In Range("D2:D" & LastRow)
CUnique.Add CellValue.Value, CStr(CellValue.Value)
Next
On Error GoTo 0
With ThisWorkbook.Sheets("TR Retail - 2022 - GLTrans")
'look at each unique value in D
For Each VUnique In CUnique
'make sure a worksheet with that name exists.
On Error Resume Next
Set ws = ThisWorkbook.Sheets(VUnique)
On Error GoTo 0
'if not, make one
If ws Is Nothing Then
Worksheets.Add.Name = VUnique
Set ws = ThisWorkbook.Sheets(VUnique)
End If
'filter the list by the Branch
.Range("D1").AutoFilter Field:=1, Criteria1:=VUnique
'copy only the filtered rows
.Range("A2:H" & LastRow).SpecialCells(xlCellTypeVisible).Copy 'change H to whatever your last column is.
'find the last row on the destination sheet
DestRows = ws.Range("D" & Rows.Count).End(xlUp).Row
'paste to the destination sheet
ws.Cells(DestRows + 1, 1).PasteSpecial
Next
'delete everything you've copied
.Range("A2:H" & LastRow).EntireRow.Delete 'change H to whatever your last column is.
End With
End Sub