Live-Forum - Die aktuellen Beiträge
Datum
Titel
17.06.2024 19:56:24
17.06.2024 19:39:46
Anzeige
Archiv - Navigation
1216to1220
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

gefilterte Daten kopieren

gefilterte Daten kopieren
kiki
Hallo,
ich bin dabei ein Makro zu schreiben, bei dem ich unter anderem gefilterte Daten kopieren muss und komme nicht weiter.
Ich habe eine Beispielmappe erstellt, damit es deutlicher wird. Ich möchte die Werte in der Spalte "Kombination" filtern, jeweils nach E, Sk und PK. Dann sollen die gefilterten Daten nach der Spalte "Summe" abwärts sortiert werden. Soweit habe ich es schon hinbekommen. Aber jetzt soll das Makro von den gefilterten Daten, also zunächst z.B. SK, die ersten fünf Zeilen nehmen und in Tabelle2 schreiben. Dann soll nach dem nächsten Kriterium gefiltert , also z.B. nach PK, und wieder nach Summe abwärts sortiert werden. Wieder sollen die ersten fünf Zeilen kopiert werden und in Tabelle2 unter die dort schon bestehende Liste SK eingefügt werden.
Hat jemand vielleicht einen Vorschlag, wie das zu bewältigen wäre? Wäre wirklich super!
https://www.herber.de/bbs/user/75454.xls
Vielen Dank und Gruß,
Kiki

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: gefilterte Daten kopieren
26.06.2011 09:05:10
Josef

Hallo Ulrike,
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Sub gefilterte_Daten()
  Dim wsDaten As Worksheet, wsKopie As Worksheet
  Dim vntCriteria() As Variant
  Dim lngIndex As Long, lngRow As Long, lngNext As Long
  On Error GoTo ErrExit
  Application.ScreenUpdating = False
  vntCriteria = Array("E", "SK", "PK")
  Set wsDaten = Worksheets("Tabelle1")
  Set wsKopie = Worksheets("Tabelle2")
  wsKopie.Range("A2:D" & Rows.Count).ClearContents
  With wsDaten
    .Range("A1").AutoFilter
    .Range("A1").CurrentRegion.Sort Key1:=.Range("C1"), Order1:=xlDescending, Header:= _
      xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
      DataOption1:=xlSortNormal
    
    For lngIndex = 0 To UBound(vntCriteria)
      lngNext = 1
      .Range("A1").AutoFilter field:=4, Criteria1:=vntCriteria(lngIndex)
      For lngRow = 2 To .Range("A1").CurrentRegion.Rows.Count
        If .Rows(lngRow).Hidden = False Then
          lngNext = lngNext + 1
          .Range(.Cells(lngRow, 1), .Cells(lngRow, 4)).Copy wsKopie.Cells(lngNext + lngIndex * 5, 1)
          If lngNext > 5 Then Exit For
        End If
      Next
    Next
    .Range("A1").AutoFilter
  End With
  ErrExit:
  Application.ScreenUpdating = True
  Set wsDaten = Nothing
  Set wsKopie = Nothing
End Sub



« Gruß Sepp »

Anzeige
AW: gefilterte Daten kopieren
26.06.2011 09:49:38
kiki
Vielen Dank Sepp für die ausführliche Antwort! ich werde versuchen, es in meine Datei einzusetzen. Muss aber erstmal den Code kapieren:-) Für einen Anfänger nicht so leicht. Entschuldige die Ungeduld, habe etwas Panik gehabt, weil ich es bis morgen fertig haben muss.
Gruß Kiki
AW: gefilterte Daten kopieren
26.06.2011 15:13:07
kiki
Hallo,
ich hab leider noch eine Frage. Kann ich diesen Teil des Makros
.Range("A1").CurrentRegion.Sort Key1:=.Range("C1"), Order1:=xlDescending, Header:= _
xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

irgendwie in die untere Schleife einbauen und zwar so, dass einmal nach C1 sortiert wird, einmal nach F1 und einmal nach I1? Für jede Sortierung soll dann wie in der Schleife schon geschehen, nach SK, PK und E gefiltert werden.
Option Explicit
Sub gefilterte_Daten()
Dim wsDaten As Worksheet, wsKopie As Worksheet
Dim vntCriteria() As Variant
Dim lngIndex As Long, lngRow As Long, lngNext As Long
On Error GoTo ErrExit
Application.ScreenUpdating = False
vntCriteria = Array("E", "SK", "PK")
Set wsDaten = Worksheets("Tabelle1")
Set wsKopie = Worksheets("Tabelle2")
wsKopie.Range("A2:D" & Rows.Count).ClearContents
With wsDaten
.Range("A1").AutoFilter
.Range("A1").CurrentRegion.Sort Key1:=.Range("C1"), Order1:=xlDescending, Header:= _
xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

For lngIndex = 0 To UBound(vntCriteria)
lngNext = 1
.Range("A1").AutoFilter field:=4, Criteria1:=vntCriteria(lngIndex)
For lngRow = 2 To .Range("A1").CurrentRegion.Rows.Count
If .Rows(lngRow).Hidden = False Then
lngNext = lngNext + 1
.Range(.Cells(lngRow, 1), .Cells(lngRow, 4)).Copy wsKopie.Cells(lngNext + lngIndex *  _
5, 1)
If lngNext > 5 Then Exit For
End If
Next
Next
.Range("A1").AutoFilter
End With
ErrExit:
Application.ScreenUpdating = True
Set wsDaten = Nothing
Set wsKopie = Nothing
End Sub

Anzeige
AW: gefilterte Daten kopieren
26.06.2011 15:36:00
Josef

Hallo Ulrike,
es genügt, wenn du die Frage in einem Thread stellst, sonst wird es ziemlich unübersichtlich.
Nachfrage: Es soll nach C, F und I sortiert werden, das ist klar. Soll dann jeweils nach allen Kriterien gefiltert werden und die Daten untereinander in Tabelle2 geschrieben werden?

« Gruß Sepp »

Anzeige
AW: gefilterte Daten kopieren
26.06.2011 15:46:42
kiki
Hallo Sepp,
ja es soll für jedes Kriterium (SK,PK,E) jeweils nach C, F und I sortiert werden und dann in eine Liste geschrieben werden.
Vielleicht ist es möglich nach jedem Kriterium in der Liste eine Linie einzufügen, damit es übersichtlich bleibt.
Gruß, Kiki
AW: gefilterte Daten kopieren
26.06.2011 16:07:16
Josef

Hallo Ulrike,
ich weiß nicht, ob ich dich richtig verstanden habe.
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Sub gefilterte_Daten()
  Dim wsDaten As Worksheet, wsKopie As Worksheet
  Dim vntCriteria() As Variant, lngSortColum() As Variant
  Dim lngIndex As Long, lngCnt As Long, lngRow As Long, lngNext As Long
  'On Error GoTo ErrExit
  'Application.ScreenUpdating = False
  vntCriteria = Array("E", "SK", "PK")
  lngSortColum = Array(3, 6, 9) 'Spaltennummern der sortierung
  Set wsDaten = Worksheets("Tabelle1")
  Set wsKopie = Worksheets("Tabelle2")
  wsKopie.Range("A2:D" & Rows.Count).Clear
  wsKopie.Cells.Borders(xlEdgeBottom).LineStyle = xlNone
  With wsDaten
    For lngCnt = 0 To UBound(lngSortColum)
      .Range("A1").AutoFilter
      .Range("A1").CurrentRegion.Sort Key1:=.Cells(1, lngSortColum(lngCnt)), _
        Order1:=xlDescending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
        Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
      For lngIndex = 0 To UBound(vntCriteria)
        lngNext = 1
        .Range("A1").AutoFilter field:=4, Criteria1:=vntCriteria(lngIndex)
        For lngRow = 2 To .Range("A1").CurrentRegion.Rows.Count
          If .Rows(lngRow).Hidden = False Then
            lngNext = lngNext + 1
            .Range(.Cells(lngRow, 1), .Cells(lngRow, 9)).Copy wsKopie.Cells(lngNext + lngIndex * 5 + lngCnt * 15, 1)
            If lngNext > 5 Then Exit For
          End If
        Next
        wsKopie.Rows(lngNext + lngIndex * 5 + lngCnt * 15).Borders(xlEdgeBottom).Weight = xlMedium
      Next
    Next
    .Range("A1").AutoFilter
  End With
  ErrExit:
  Application.ScreenUpdating = True
  Set wsDaten = Nothing
  Set wsKopie = Nothing
End Sub



« Gruß Sepp »

Anzeige
AW: gefilterte Daten kopieren
26.06.2011 18:13:21
kiki
Vielen, vielen Dank! Es hat alles geklappt und ich kann entspannt dem morgigen Tag entgegen sehen:-)
Gruß, Kiki

303 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige