Gemme sorterede rækker til nye excel filer

Indsættes under ark1 i Fil med alle navne


Const gemSti = "C:\Documents and Settings\pb.KHNBPB\Skrivebord\fordelTilMapper\"    'justeres
Dim antalrækker As Long, aktuelleNavn As String, navn As String, ræk As Long
Dim fraRæk As Long
Public Sub fordelingAfMapper()
    antalrækker = ActiveCell.SpecialCells(xlLastCell).Row
   
    navn = ""
   
    For ræk = 1 To antalrækker + 1
        aktuelleNavn = Range("A" & ræk)
        If navn = "" Then
            navn = aktuelleNavn
            fraRæk = 1
        Else
            If aktuelleNavn <> navn Then
                ActiveSheet.Rows(fraRæk & ":" & ræk - 1).Select
                Selection.Copy
               
                Workbooks.Add
                ActiveSheet.Paste
                ActiveWorkbook.SaveAs navn & ".xls"
                ActiveWorkbook.Close
               
                navn = aktuelleNavn
                fraRæk = ræk
            End If
        End If
    Next ræk
End Sub

Hej Supertekst
Din løsning sidder lige i skabet.
Eneste korrektion jeg har gjort er tilføjelse af "gemSti &" i:

ActiveWorkbook.SaveAs gemSti & navn & ".xls"

Tak for indsatsen.

Venligst send et svar så jeg kan tildele points.

Fint - og selv tak