• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Werkbladen sorteren

Status
Niet open voor verdere reacties.
D

DeArie

Gebruiker
Lid geworden
15 jul 2016
Berichten
126
Is het mogelijk om werkbladen te sorteren op het @ teken in de werkblad naam?

Ik moet maandelijks ongeveer 100 werkbladen sorteren de namen beginnen altijd met 6 cijfers gevolgd door een spatie en dan of een @ met een naam gelijk erachter of alleen maar een naam BV:

123456 @voorbeeld
123456 voorbeeld

Nu zou ik graag willen dat het gesorteerd wordt op het @ teken dat deze bij elkaar gezet worden en dan welke er overblijven die weer bij elkaar is dat mogelijk?
Ik zie genoeg voorbeelden hier en elders maar dat is sorteren op alfabet of kleur of numeriek.

En als dit al mogelijk is hoe heet het zodat ik misschien gerichter kan zoeken. Alvast bedankt
 
Maak er eens een voorbeeldje van, dan is de macro zo gemaakt denk ik :).
 
Run deze eens

Code: 
Sub jvv()
 For i = 1 To Sheets.Count - 1
  For ii = i + 1 To Sheets.Count
       a = InStr(Sheets(ii).Name, "@")
       b = InStr(Sheets(i).Name, "@")
       If IIf(a = 0, 99, a) < IIf(b = 0, 99, b) Then Sheets(ii).Move Sheets(i)
   Next
 Next
End Sub
 
Laatst bewerkt:
Ik denk dat deze het beter doet:
Deze gaat vervolgens nog sorteren op positie van de spatie

Code: 
Sub jvv()
 For i = 1 To Sheets.Count - 1
  For ii = i + 1 To Sheets.Count
       a = InStr(Sheets(ii).Name, "@")
       b = InStr(Sheets(i).Name, "@")
       If IIf(a = 0, 99, a) < IIf(b = 0, 99, b) Then Sheets(ii).Move Sheets(i)
   Next
 Next
 
 For i = 1 To Sheets.Count - 1
  For ii = i + 1 To Sheets.Count
    If InStr(Sheets(ii).Name, "@") = 0 And InStr(Sheets(i).Name, "@") = 0 Then
       If InStr(Sheets(ii).Name, " ") < InStr(Sheets(i).Name, " ") Then Sheets(ii).Move Sheets(i)
    End If
   Next
 Next
End Sub
 
Laatst bewerkt:
Die andere deed het voor mij al perfect deze ook even geprobeerd maar zie zo snel even geen verandering.
 
Code: 
Sub M_snb()
  ReDim st(Sheets.Count - 1, 0)
    
  For j = 1 To Sheets.Count
    st(j - 1, 0) = Sheets(j).Name
  Next
    
  With Cells(1, 10).Resize(UBound(st) + 1)
    .Value = st
    .Sort Cells(1, 10)
    st = Application.Transpose(.Value)
    .ClearContents
  End With
    
  For jj = 1 To 2
    sp = Filter(st, "@", jj = 1)
    c00 = sp(UBound(sp))
    If jj = 1 Then Sheets(sp(0)).Move Sheets(1)
    If jj = 2 Then Sheets(sp(0)).Move , Sheets(c00)
    For j = 1 To UBound(sp)
      Sheets(sp(j)).Move , Sheets(sp(j - 1))
    Next
  Next
End Sub
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan