Sortering af regneark med 6000 linier

Stil dig på første kundenavn og kør makroen.

Kravet er at der er en tom række, eller flere imellem kunderne, den skriver dem over i c og d kolonnen.

Public Sub Flyt()
    Dim Data As Variant, I As Long, RW As Long
    Dim Fra As String, Til As String, Kunde As String
    Fra = ActiveCell.Address
    Til = Cells(65536, ActiveCell.Column).End(xlUp).Offset(1, 0).Address
    Data = Range(Fra & ":" & Til)
    For I = 1 To UBound(Data, 1)
        If Kunde = "" Then Kunde = Data(I, 1)

        If Not IsEmpty(Data(I, 1)) And Kunde <> Data(I, 1) Then
            RW = Range("C65536").End(xlUp).Row + 1
            Cells(RW, 3) = Kunde
            Cells(RW, 4) = Data(I, 1)
        End If
        If IsEmpty(Data(I, 1)) Then Kunde = ""
    Next
End Sub

Hej Kabbak,
Tak for dit svar. Desværre er min virkelighed lidt anderledes end eksemplet og macroen virker ikke efter hensigten.

Jeg har følgende kolonner med tilhørende indhold.

Number      Type    Due Date    Amount    Current    (Invoice)

kunde 1      data    data        data      data   

3044367
3045378

Tallene er invoice numre, som står i samme kolonne som kundenavnet. Jeg forestiller mig, at det kunne stå således.

Kunde 1                                            3044367
Kunde 1                                            3045378

Dermed kan jeg bevare det andet data.

Håber du kan hjælpe.

Mvh.
Mfynbo

Hvis dine data står sådan her:

Number         Type       Due Date       Amount       Current       (Invoice)
kunde 1          data       data           data         data      
3044367                   
3045378                   
                   
kunde 2          data       data           data         data      
3044369                   
3045388                   

Så komme det til at se sådan ud:

Number         Type       Due Date       Amount       Current       (Invoice)
kunde 1          data       data           data         data      
kunde 1    3044367               
kunde 1    3045378               
                   
kunde 2          data       data           data         data      
kunde 2    3044369               
kunde 2    3045388               

Med denne Kode:

Public Sub Flyt()
    Dim Data As Variant, I As Long, RW As Long
    Dim Fra As String, Til As String, Kunde As String
    Fra = "$A$2"
    Til = Cells(65536, "A").End(xlUp).Offset(1, 1).Address
    Data = Range(Fra & ":" & Til)
    For I = 1 To UBound(Data, 1)
        If Not IsNumeric(Data(I, 1)) And Not IsEmpty(Data(I, 1)) Then Kunde = Data(I, 1)

        If IsNumeric(Data(I, 1)) And Not IsEmpty(Data(I, 1)) Then
            Data(I, 2) = Data(I, 1)
            Data(I, 1) = Kunde
        End If
    Next
    Range(Fra & ":" & Til) = Data
End Sub