Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1672to1676
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

richtig kopieren nach Kriterien

richtig kopieren nach Kriterien
10.02.2019 10:52:27
Fred

Hallo Excel-Profis,
die letzten Tage habe ich ja relativ oft hier unterschiedliches angefragt,- bitte einmal noch! Sozusagen das SonntagsEi :-)
Ich kopiere und füge ein in gleicher Mappe.
Dies geschieht derzeit nach Kriterien im Blatt "Kriterien".
Das Problem:
Ich möchte ausschließlich die Teams als Heim,- und Gastmannschaft als Ergebnis haben, die ich in "Kriterien" angegeben habe.
So wie ich das aufgebaut habe, kann es aber auch nicht klappen.
Ich habe eine vereinfachte Mappe hier angefügt, um mein Anliegen zu verdeutlichen.
https://www.herber.de/bbs/user/127543.xlsb
Kann sich dies bitte mal jemand anschauen .....
Mit freundlichen Gruß
Fred Neumann

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: richtig kopieren nach Kriterien
10.02.2019 12:47:07
Sepp
Hallo Fred,
eine Möglichkeit.
https://www.herber.de/bbs/user/127547.xlsm
 ABCDEF
1Gruß Sepp
2
3

Anzeige
AW: richtig kopieren nach Kriterien
10.02.2019 13:39:04
Fred
Hallo Sepp,
danke für deine Version!!
Das Ergebnis (nur die angegebenen Teams werden als Heim,- GastTeam berücksichtigt) ist 100 % das, was ich wollte.
Allerdings wird die Beschriftung "Blatt:Spiele" von K1:AL1 gelöscht und die darunter liegenden Werte (Zeile2) nicht runter kopiert.
https://www.herber.de/bbs/user/127548.xlsm
Dein VBA ist total anders als meines aufgebaut,- könntest du nochmals drauf schauen und das löschen der Überschriften als auch das runter kopieren mit einbauen?
Gruß
Fred
AW: richtig kopieren nach Kriterien
10.02.2019 13:50:22
Sepp
Hallo Fred,
Sub DatenNach_Spiele()
  Dim varFilter() As Variant, varItems As Variant
  Dim lngI As Long, lngN As Long, lngM As Long, lngLast As Long
  
  With Sheets("Spiele")
    .Range("A2:J" & .Rows.Count).ClearContents
    .Range("K3:AL" & .Rows.Count).ClearContents
  End With
  
  With Sheets("Kriterien")
    lngLast = .Cells(1, .Columns.Count).End(xlToLeft).Column
    Redim varFilter(1 To lngLast)
    lngN = lngLast
    For lngI = 1 To lngN
      If Application.CountA(.Columns(lngI)) > 1 Then
        lngLast = Application.Max(2, .Cells(.Rows.Count, lngI).End(xlUp).Row)
        varItems = Application.Transpose(.Range(.Cells(2, lngI), .Cells(lngLast, lngI)))
        If IsArray(varItems) Then
          For lngM = 1 To Ubound(varItems)
            varItems(lngM) = CStr(varItems(lngM))
          Next
        Else
          varItems = CStr(varItems)
        End If
        varFilter(lngI) = varItems
      End If
    Next
  End With
  
  With Sheets("Basis")
    With .Range("A1").CurrentRegion
      .AutoFilter
      For lngI = 1 To Ubound(varFilter)
        If Not IsEmpty(varFilter(lngI)) Then
          .AutoFilter Field:=lngI, Criteria1:=varFilter(lngI), Operator:=xlFilterValues
        End If
      Next
      .SpecialCells(xlCellTypeVisible).Copy Sheets("Spiele").Range("A1")
      .AutoFilter
    End With
  End With
  
  With Sheets("Spiele")
    lngLast = Application.Max(2, .Cells(.Rows.Count, 2).End(xlUp).Row)
    .Range("K2:AL2").AutoFill .Range("K2:AL" & lngLast)
    Application.Goto .Range("A1"), True
  End With
  
End Sub

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media

Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0


 ABCDEF
1Gruß Sepp
2
3

Anzeige
AW: richtig kopieren nach Kriterien
10.02.2019 13:56:56
Fred
echt Klasse, Sepp!
Dir noch einen schönen Sonntag
Gruß
Fred

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige