Søge og kopiere fra et faneblad til et andet + sortering

Det ser ud til at virke som det skal men så er der lige det her ?
hvis jeg så vil have at de rækker der står Markedskunde i bliver flyttet ned efter Inaktive Kunde og Ny Kunde og
Reaktiveret kunde bliver flyttet op efter Aktiv kunde så det ser sådan her ud :

Aktiv Kunde
Ny Kunde
Reaktiveret Kunde





Inaktiv Kunde
Markedskunde


bagefter skal den sortere i kolonne G alle dem der hedder
Aktiv Kunde
Ny Kunde
Reaktiveret Kunde

og derefter sortere kolonne F alle dem der hedder
Aktiv kunde
Ny Kunde
Reaktiveret Kunde

Og derefter sortere i kolonne G alle dem der hedder
Inaktiv Kunde
Markedskunde

Og tilsidst sortere i kolonne F alle dem der hedder
Inaktiv Kunde
Markedskunde.

Lige en let én.

Kender du til autofilter? Prøv at markere kolonne "M". Gå op i <Data><Filter><Autofilter>
Du får nu en knap ved celle M1. Prøv at klikke og leg lidt med den!

Ja det var let men hvorfor vil den have Reaktiveret kunde øverst ?

Jeg tror du mener Aktiveret kunde. Den tager det alfabetisk. Filteret sorterer og bytter intet i arket, men skjuler bare de irelevante celler.

Du kan markere A-N kolonnerne og slå autofilter til. Så kan du i M vælge "Inaktiv kunde" - disse bliver vist - andre skjult. Derefter går du til kolonne G og via filteret vælger "sortér stigende", eller hvad du ønsker.

Jeg ved jo ikke hvad formålet med dit ark er, men det er en meget let løsning, hvis du kan nøjes med at få vist en kundegruppe af gangen!

jeg syntes ikke at det er brug bar til at udskrive listen bagefter der skal det jo stå sådan som den fil jeg sendte dig på mail

jeg taler om filen jeg sendte til dig der står Reaktiveret kunde øverst i kolonne M i det nye ark når man intaster 204 ?

Prøv denne:

Private Sub CommandButton3_Click()
Dim MitRange

Sheets("ny").Copy After:=Sheets("tal")
Set NewSheet = ActiveSheet
NewSheet.Visible = True

'FindTal sætte til den værdi du skriver
FindTal = Application.InputBox( _
Prompt:="Skriv tallet du søger", _
Title:="Find nummeret du skriver:", Type:=2)

If FindTal <> False And IsNumeric(FindTal) Then 'checker om du skrev noget og om det er et tal. "And IsNumeric(FindTal)" skal udelukkes hvis du vil kunne søge på andet end tal
Fejl = 0
For Each ws In Worksheets 'går alle arknavne igennem
If ws.Name = FindTal Or Left(ws.Name, 6 + Len(FindTal)) = (FindTal & " (Kopi") Then 'hvis arknavn findes tælles op
    Fejl = Fejl + 1
End If
Next
If Fejl > 0 Then
    NewSheet.Name = FindTal & " (Kopi" & Fejl & ")"
Else
    NewSheet.Name = FindTal
End If

MitRange = Sheets("Tal").Range("A2:P6000") 'laver et array ved navn MitRange
KolonneTal = UBound(MitRange) 'finder længden på dit array


Application.ScreenUpdating = False 'slår skærmopdatering fra

LTal = Len(FindTal) 'finder ud af hvor langt tallet er
    For i = 1 To KolonneTal
        If Left(MitRange(i, 1), LTal) = FindTal And Not IsNumeric(Mid(MitRange(i, 1), LTal + 1, 1)) Then
            step = step + 1
            IAlt = IAlt + 1
            Sheets("Ny").Cells(step + 1, 1).Value = MitRange(i, 1)
                NewSheet.Cells(step + 1, 1).Value = MitRange(i, 1)
                NewSheet.Cells(step + 1, 3).Value = MitRange(i, 14)
                NewSheet.Cells(step + 1, 4).Value = MitRange(i, 3)
                NewSheet.Cells(step + 1, 5).Value = MitRange(i, 4)
                NewSheet.Cells(step + 1, 6).Value = MitRange(i, 5)
                NewSheet.Cells(step + 1, 7).Value = MitRange(i, 6)
                NewSheet.Cells(step + 1, 8).Value = MitRange(i, 7)
                NewSheet.Cells(step + 1, 9).Value = MitRange(i, 8)
                NewSheet.Cells(step + 1, 10).Value = MitRange(i, 9)
                NewSheet.Cells(step + 1, 11).Value = MitRange(i, 10)
                NewSheet.Cells(step + 1, 12).Value = MitRange(i, 11)
                NewSheet.Cells(step + 1, 13).Value = MitRange(i, 12)
                NewSheet.Cells(step + 1, 14).Value = MitRange(i, 16)
        End If
    Next

MsgBox ("Der blev overført " & IAlt & " celleværdier.")
NewSheet.Range("B1").Select

NewSheet.Range("M1:M" & NedersteCelle + 1).Select 'vælger det område der er værdier i
NewSheet.Range("A1:N" & NedersteCelle + 1).Sort Key1:=NewSheet.Range("M2"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

Dim RankArray
RankArray = NewSheet.Range("A2:N" & IAlt + 1)
Dim Skift
Dim test As Variant

test = Array("AKTIV KUNDE", "NY KUNDE", "REAKTIVERET KUNDE", "INAKTIV KUNDE", "MARKEDSKUNDE")
ReDim Temp(14)
N = UBound(RankArray)
For XY = 0 To 4
    For i = 1 To N - 1
        For j = i To N
            If UCase(Left(RankArray(i, 13), Len(test(XY)))) = test(XY) Then
                For Skift = 1 To 14
                    Temp(Skift) = RankArray(i, Skift)
                    RankArray(i, Skift) = RankArray(j, Skift)
                    RankArray(j, Skift) = Temp(Skift)
                Next
            End If
        Next
    Next
Next
NewSheet.Range("A2:N" & IAlt + 1) = RankArray

MArray = NewSheet.Range("M2:M" & IAlt + 1)
Dim NotOk
NotOk = 1
Do While NotOk < IAlt + 1
NotOk = NotOk + 1
    If UCase(Left(MArray(NotOk, 1), 13)) = "INAKTIV KUNDE" Then
        Fundet = NotOk + 1
        NotOk = IAlt + 1
    End If
Loop
For RkLoop = 1 To 5
    NewSheet.Rows(Fundet & ":" & Fundet).Select
    Selection.Insert Shift:=xlDown
Next
NewSheet.Range("A1:N" & Fundet - 1).Sort Key1:=NewSheet.Range("G2"), Order1:=xlAscending, Key2:=NewSheet.Range( _
    "F2"), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase _
    :=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
    DataOption2:=xlSortNormal
NewSheet.Range("A" & Fundet + 5 & ":N" & IAlt + 5).Sort Key1:=NewSheet.Range("G" & Fundet + 5), Order1:=xlAscending, Key2:= _
        NewSheet.Range("F" & Fundet + 5), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, _
        MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
        DataOption2:=xlSortNormal
MsgBox "Færdig"
Else
    MsgBox "Du skrev ikke et tal!" & vbLf _
    & "Jeg stopper her :-)"
End If
Application.ScreenUpdating = True
End Sub

Den afsluttende sortering er jeg lidt i tvivl om jeg har forstået rigtigt. Men prøv!

Nu tror jeg sku' den er der, du er bare for hård til det her !
Kan man få den til at kikke efter 204 i Kolonne L i stedet for A ? for så Skal jeg ikke kopiere fra L til A først.

jeg mener i faneblad Tal

Det skulle bare være således:

If Left(MitRange(i, 1), LTal) = FindTal And Not IsNumeric(Mid(MitRange(i, 1), LTal + 1, 1)) Then

rettes til

If Left(MitRange(i, 12), LTal) = FindTal And Not IsNumeric(Mid(MitRange(i, 12), LTal + 1, 12)) Then

(Har ikke testet)

der var lige lidt andet der også skulle rettes men virker sku kanon nu ! jeg takker for din store hjælp ! hvordan giver jeg dig nogle point ?

Når jeg har puttet dette svar :-)

Glad for det virker. Husk lige til en anden gang at komme med hele opgaven på en gang. Koden er blevet noget rodet af alle de ændringer.

held og lykke med det.

Lukker du?

ja hvis jeg viste hvordan ?

Hej igen.
Markér mit navn ved siden af skrivevinduet, der står nu akyhne og scharff. Klik på acceptér.

Imellem nederste/sidste spm. og skrivefeltet...

Håber det ok nu

Fint. Tak for point.