Microsoft Excel

Herbers Excel/VBA-Archiv

Sortieren mit VBA Makro | Herbers Excel-Forum


Betrifft: Sortieren mit VBA Makro von: Bruno
Geschrieben am: 16.01.2012 23:55:11

Werte Excel-Spezialisten

Mit hier im Archiv gefundenen Lösungsbeiträgen habe ich mir das nachstehende Makro zusammengebastelt. Es bleibt leider bei der beabsichtigten Sortierung stehen (orange Codezeilen). Wenn ich aber die mit dem Makro richtig übertragenen Spalten anschliessend manuell über das Menu sortiere, klappt es problemlos. Die Aufzeichnung dieser manuellen Sortierung mit dem Makrorecorder liefert den unten in Orange abgebildeten Code zurück. Was habe ich bei dessen Einbau falsch gemacht?


Private Sub Cmd_FilterDaten_Click()
Dim lastrow As Long
Dim i As Long
Dim Ymax As Long

Application.ScreenUpdating = False

Sheets("FilterDaten").Activate
  ActiveSheet.Columns("A:C").Select
  Selection.ClearContents                       

  With Sheets("Datentabelle")                             'letzte Zeile in Spalte B, C, D ermitteln und 1. Zeile bestimmen.
    Ymax = WorksheetFunction.Max( _
    .Range("B" & Rows.Count).End(xlUp).Row, _
    .Range("C" & Rows.Count).End(xlUp).Row, _
    .Range("D" & Rows.Count).End(xlUp).Row)
    Debug.Print
    .Range(.Cells(6, 4), .Cells(Ymax, 2)).Copy       'Ab B7 bis D Ende (letzte belegte Zeile) kopieren
  End With

Sheets("FilterDaten").Activate
  With ActiveSheet
    .Range("A1").PasteSpecial xlPasteValues         'kopierte Werte einfügen, aufsteigend sortieren
    .Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
     OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
  End With

Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

  
Für Korrekturvorschläge besten Dank zum Voraus, Bruno

  

Betrifft: AW: Sortieren mit VBA Makro von: Josef Ehrensberger
Geschrieben am: 17.01.2012 00:01:28


Hallo Bruno,

teste mal.

Private Sub Cmd_FilterDaten_Click()
  Dim lastrow As Long
  Dim i As Long
  Dim Ymax As Long
  
  On Error GoTo ErrExit
  
  Application.ScreenUpdating = False
  
  Sheets("FilterDaten").Columns("A:C").ClearContents
  
  With Sheets("Datentabelle") 'letzte Zeile in Spalte B, C, D ermitteln und 1. Zeile bestimmen.
    Ymax = WorksheetFunction.Max( _
      .Range("B" & Rows.Count).End(xlUp).Row, _
      .Range("C" & Rows.Count).End(xlUp).Row, _
      .Range("D" & Rows.Count).End(xlUp).Row)
    Debug.Print
    .Range(.Cells(6, 4), .Cells(Ymax, 2)).Copy 'Ab B7 bis D Ende (letzte belegte Zeile) kopieren
  End With
  
  With Sheets("FilterDaten")
    .Range("A1").PasteSpecial xlPasteValues 'kopierte Werte einfügen, aufsteigend sortieren
    .Range("A1").CurrentRegion.Sort Key1:=.Range("A1"), _
      Order1:=xlAscending, Header:=xlGuess
  End With
  
  ErrExit:
  Application.CutCopyMode = False
  Application.ScreenUpdating = True
End Sub






« Gruß Sepp »



  

Betrifft: AW: Sortieren mit VBA Makro von: Bruno
Geschrieben am: 17.01.2012 10:35:43

Guten Morgen Sepp und besten Dank für Deine schnelle Hilfe!

so funktionierts:


Sheets("FilterDaten").Activate
  With ActiveSheet
    .Range("A1").PasteSpecial xlPasteValues
    .Range("A1").CurrentRegion.Sort Key1:=.Range("A1"), _
     Order1:=xlAscending, Header:=xlGuess
  End With

an Stelle von:

  With Sheets("FilterDaten")
    .Range("A1").PasteSpecial xlPasteValues
    .Range("A1").CurrentRegion.Sort Key1:=.Range("A1"), _
     Order1:=xlAscending, Header:=xlGuess
  End With  
     
Dein Originalvorschlag ohne «Sheets("FilterDaten").Activate» überträgt nur die erste Zeile und überschreibt mir auch die Inhalte nach der Spalte C in der Zieltabelle «FilterDaten». Warum dies so ist, übersteigt meine bescheidenen VBA-Kenntnisse. Trotzdem: Zielsetzung erfüllt!!

Gruss, Bruno


Beiträge aus den Excel-Beispielen zum Thema "Sortieren mit VBA Makro"