Hi Mr Brocklander

The problem was indeed not as trivial as I thought at first. And I hope
I understood this time what you want. If so, the code hereafter should
do the job.

If a sister store exists it is expected in column C, e.g.
A B C
1 101 6
2 101
3 101 8
4 101
5 102
6 103
7 105
8 105

The records 6 103 and 8 105 will be added tot file 101.xls


Option Explicit
Const StoreCol = 1, TerCol = 2, SisCol = 3
Private CurrentSheet As Worksheet, NextRow As Long
Sub BL()
Dim Ro As Long, Cro As Long, Lastrow As Long
Dim LookInCol As Long, Store As Long, SisterStore As Long
Dim Terry As String, LookFor As String
Dim ra As Range

Application.ScreenUpdating = False
ActiveSheet.Cells.Copy
Worksheets.Add
Cells.PasteSpecial xlPasteAll
Application.CutCopyMode = False

Do
Ro = 1
Terry = Cells(Ro, TerCol)
If Len(Terry) = 0 Then Exit Do
Call NewFile(Terry)
Do
Call WriteRow(Ro)
SisterStore = Cells(Ro, SisCol)
Rows(Ro).Delete
LookInCol = TerCol
LookFor = Terry
If SisterStore Then
If WorksheetFunction.CountIf(Columns(StoreCol),
SisterStore) Then
LookFor = SisterStore
LookInCol = StoreCol
End If
End If
Set ra = Columns(LookInCol).Find(LookFor, LookIn:=xlValues,
lookat:=xlWhole)
If ra Is Nothing Then Exit Do
Ro = ra.Row
Loop
Call CloseFile
Loop

With Application
.DisplayAlerts = False
ActiveSheet.Delete
.DisplayAlerts = True
.ScreenUpdating = True
End With

End Sub

Sub NewFile(FileName As String)
Dim s As Worksheet

Set s = ActiveSheet
Set CurrentSheet = Worksheets.Add
CurrentSheet.name = FileName
NextRow = 1
s.Activate

End Sub

Sub WriteRow(r As Long)
Dim s As Worksheet

CurrentSheet.Rows(NextRow).Value = Rows(r).Value
NextRow = NextRow + 1

End Sub

Sub CloseFile()
Dim FilNam As String

With CurrentSheet
FilNam = .name
.Columns(SisCol).Delete xlShiftToRight ' remove the Sister
Store column from the result
.Move ' to a new workbook
End With

ActiveWorkbook.SaveAs FilNam
ActiveWorkbook.Close

End Sub