Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Mehrere Sheets filtern
#1
Smile 
Hallo Community, 

Ich brauche dringend eure Hilfe, weil ich nach stundenlanger Foren Suche immer noch nichts geklappt hat.

- Ich habe eine Exceltabelle mit 12 Sheet

- Jedes dieser 12 Sheets ist gleich aufgebaut

- Wenn in der Spalte D "prüfen" steht, soll diese Zeile auf das 13. Sheet kopiert werden

-Die Liste wird andauernd aktualisiert, sodass sich die Liste im 13. Sheet auch aktualiseren sollte.

Vielen Dank im Voraus ! Angel
Antworten Top
#2
Hallo,

Wenn man davon ausgeht, dass der Index der Monate 1-12 ist und das Ergebnis-sheet "Result" heist, könnte folgender Code helfen:

Sub excelgirl()
Dim ws as sheets
Dim rng as range
NSh = thisworkbook.sheets.count -1
MySuch = "Prüfen"

For i = 1 to nSh
With sheets(i).columns(4)
Set rng = .find(mySuch)
If not rng is nothing then

Zeile = rng.row
.cells(zeile) = "ok"
.rows(zeile).entirerow.copy
Lr = sheets("Result").range("a1").currentregion.rows.count +1
Sheets("Result").cells(lr,1).pastespecial
Application.cutcopymode = false
End if

Set rng = nothing
End with
Next
End sub

Das Makro ändert jeweils "Prüfen" in "ok", damit Zeilen nur einmal kopiert werden. Entweder muss der Makro regelmäßig von Hand gestartet werden, oder mit "application.onTime" in eine selbstaufrufende Schleife gelegt werden.

Mfg
Antworten Top
#3
Hallo,

erst einmal vielen Dank!

Ich habe jetzt den Code versucht. Bei der Zeile

With Sheets(i).Columns(4)

kommt ein Laufzeitfehler 40036 Anwendungs-oder objektdef. Fehler
Antworten Top
#4
Hallo,

1. bis welcher Spalte sind Daten vorhanden?
2. Sind Überschriften vorhanden?
3. wenn ja, sind die Überschriften in allen identisch?
4. kommt der gesuchte Wert "prüfen" nur einmal vor oder kann er mehrmals vorkommen?
5. Bei Fund, soll der Wert "prüfen" verändert werden oder bleibt an der Fundstelle alles so wie es war?

Das Aktualisieren würde ich beim betreten der Ergebnistabelle automatisch über das WorksheetActivate Ereignis anstoßen.
Gruß Atilla
Antworten Top
#5
1. bis welcher Spalte sind Daten vorhanden?
- bis Spalte K


2. Sind Überschriften vorhanden?
Ja, außer in Spalte  A und B , diese sind komplett leer

3. wenn ja, sind die Überschriften in allen identisch?
Ja

4. kommt der gesuchte Wert "prüfen" nur einmal vor oder kann er mehrmals vorkommen?
kommt mehrmals vor 

5. Bei Fund, soll der Wert "prüfen" verändert werden oder bleibt an der Fundstelle alles so wie es war?
soll so bleiben
Antworten Top
#6
Hallo,

Der Code unterstellt, dass der Sheet-Index von 1-12 existiert, falls nicht muss die for...next schleife in eine for'each.Schleife'umgesetz'werden. Eine Markierung der bereits kopierten Zeilen ist notwendig, damit Zeilen nicht doppelt kopiert werden, wie das umgesetz wird, ist beliebig.

Der Code'kopiert jedesmal nur den ersten Treffer, muss also mehrfach laufen. Dies kann auch im Programm erledigt werden:

Am Anfang:

Flag = false

In der if -Passage:

Flag = true

Und am Ende:

If flag then excelgirl



Mfg
Antworten Top
#7
Hallo,

wie heißen denn die Überschriften?
Gruß

Edgar

Meine Antworten sind freiwillig und ohne Gewähr!
Über Rückmeldungen würde ich mich freuen.
Antworten Top
#8
Hallo,

folgendes ist gegeben.

Die Tabelle, in die kopiert werden soll, heißt "Übersicht"

Dann folgenden Code hinter die Tabelle "Übersicht"


Code:
Private Sub Worksheet_Activate()
 Call aktualisieren
End Sub


und weiter folgenden Code in ein allgemeines Modul

Code:
Option Explicit

Sub aktualisieren()
 Dim i As Long
 Dim lngA As Long, lngZ As Long
 Dim strSuch As String
 Sheets("Übersicht").Select   'falls mal versehentlich aus einer anderen Tabelle heraus aufgerufen wurde
 strSuch = "prüfen" 'gesuchter Wert
 Range("C1").CurrentRegion.Offset(1, 0).ClearContents
 Range("AA1").CurrentRegion.Clear
 lngZ = 2
 Application.ScreenUpdating = False
 For i = 1 To Sheets.Count
   If Sheets(i).Name <> ActiveSheet.Name Then
     With Sheets(i)
       lngA = Application.CountIf(Sheets(i).Columns("D"), strSuch)
       If lngA > 0 Then
         Range("AA1") = Range("d1")
         Range("AA2") = strSuch
         .Range("C1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
           "AA1:AA2"), CopyToRange:=Range("AB1:AK1"), Unique:=False
         Range("AB2:AK" & lngA + 1).Copy Range("C" & lngZ)
         lngZ = lngZ + lngA
         End If
     End With
   End If
 Next i
 Range("AA1").CurrentRegion.Clear
 Application.ScreenUpdating = True
End Sub


Du kannst den Code manuell starten oder aber er wird automatisch bei Aktivierung der Tabelle "Übersicht" gestartet.
Gruß Atilla
Antworten Top
#9
@ Attilla
Bei 

Range("C1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _

           "AA1:AA2"), CopyToRange:=Range("AB1:AK1"), Unique:=False


kommt ein Fehler


@Fennek
Was ist mit einer Schleife gemeint? 


@BoskoBiati von der Tabelle oder von den Sheets?
Antworten Top
#10
Abei eine Beispieldatei


Angehängte Dateien
.xlsm   MsOfficeFrage.xlsm (Größe: 60,78 KB / Downloads: 4)
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste