Automatisch sorteren mbv Macro

[Bart198099]

Beste allen,

Ik heb een vraag over een macro, ik heb al meerdere berichten op dit forum gevonden over dit item maar ik krijg het niet goed in mijn document:
Bekijk bijlage Klachtentest 1.xlsm

Ik heb een macro gemaakt om de data in blad2 te ordenen. Nu wil ik ook graag dat deze data netjes gesorteerd wordt zoals op blad1.
De macro die ik hiervoor maak werkt niet, ik vermoed dat het door de lege regels komt.

Is hier een oplossing voor?

Alvast bedankt.
Bart

 

[mcs51mc]

Begrijp ik het goed dat je de "wanordelijke" data van Blad2 (automatisch) gesorteerd wil krijgen als te zien op Blad1; Is dat de vraag?
Is er een bepaalde regelmaat in Blad2? Ik kan ze in elk geval niet vinden
Mocht die regelmaat er zijn, dan zou dat met een macro wel op te lossen zijn.
Maar nu lijkt de data mij willekeurig neergeploft te zijn in Blad2

Waar komt die data eigenlijk vandaan?
Is het een tekstfile die je ingelezen hebt in Excel?
Wanneer dat zo is, dan moet er misschien vanaf die file gestart worden om een gesorteerde lijst te maken... ...

 

[Bart198099]

De data komt uit een automatiseringssysteem, dit is het exportbestand..

In principe heb ik het redelijk opgelost met de macro die er in zit: ctrl-p
vervolgens wil ik het sorteren op kolom B. Dan krijg je het format zoals op blad1.

alleen die laatste stap, het sorteren op kolom B krijg ik niet in een macro.

Groet
Bart

 

[mcs51mc]

Probeer dit eens

Sub Macro2()
'
' Macro2 Macro
'
' Sneltoets: Ctrl+o
'
    Cells.Select
    With ActiveWorkbook.Worksheets("Blad2").Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("B1:B440"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        
        .SetRange Range("A1:K440")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Je krijgt dan in Blad2 identiek hetzelfde als in Blad1.
Is je probleem dan opgelost of niet?

 

[VenA]

je <Ctrl> + p macro kan ook nog wel iets eenvoudiger:

Sub Verwijder()
    Application.ScreenUpdating = False
    Range("B7:B10").Delete Shift:=xlUp
    Range("C7").Delete Shift:=xlUp
    Range("H4:H6").Insert Shift:=xlDown
    Range("I7:I9").Delete Shift:=xlUp
    Columns("D:G").Delete Shift:=xlToLeft
    Columns("F:H").Delete Shift:=xlToLeft
    Rows("1:6").Delete Shift:=xlUp
    Columns("A:E").EntireColumn.AutoFit
    Application.ScreenUpdating = True
End Sub

 

[snb]

of in plaats van alle overige code:

Sub M_snb()
  With Sheets("Blad2")
    sn = .UsedRange
    ReDim sp(Application.CountIf(.Columns(1), "Info:"), 4)
  End With
  jj = 0
    
  For j = 1 To UBound(sn)
    If sn(j, 1) = "Info:" Then
      sp(jj, 0) = sn(j - 4, 1)
      sp(jj, 1) = sn(j, 2)
      sp(jj, 2) = sn(j - 3, 3)
      sp(jj, 3) = sn(j - 7, 8)
      sp(jj, 4) = sn(j - 1, 9)
      jj = jj + 1
    End If
  Next

  With Sheets("Blad3")
    .Cells(1).Resize(UBound(sp) + 1, UBound(sp) + 1) = sp
    .Cells(1).CurrentRegion.Sort .Cells(1, 3), , , , , , , , xlNo
  End With
End Sub

 

[Bart198099]

Beste allen,

Dank voor de reacties, met de eerste formule heb ik het opgelost.

De laatste 2, waarbij het in 1 keer zou moeten lukken werkt helaas niet, ik denk dat ik wat fout doe bij het plakken.
(ik ben, zoals wel duidelijk, nog niet heel bekend met visual basic)

Groeten,
Bart

 

[Bart198099]

Aha, laatste ook gelukt... het staat op blad 3 haha.

DANK!