Live-Forum - Die aktuellen Beiträge
Datum
Titel
20.04.2024 00:49:19
Excel Sheet in einen Excel Kalender einfügen
20.04.2024 00:08:11
In Ordner nur das Speichern von Dateien erlauben
19.04.2024 21:26:15
mehrfache Texte finden
19.04.2024 19:41:34
Bei VBA Ausführung Anzeige einfrieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
812to816
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
812to816
812to816
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Alle Tabellenblätter durchsuchen

Alle Tabellenblätter durchsuchen
23.10.2006 13:29:55
Mike
Hallo Ihr lieben im Forum.
Ich habe vor Kurzem aus dem Archiv von (Ralf anton - Geschrieben am: 27.06.2006 11:32:45)
folgenden VBA Code ausprobiert. Der Funktioniert auch super. Danke!

Sub Durchlauf()
Dim x As Byte, zelle, Bereich$, Zeile#, ende$
Zeile = 1
For x = 1 To Sheets.Count
If Not Sheets(x).Name = "Sammelblatt" Then
ende = Sheets(x).Range("A1").SpecialCells(xlLastCell).Address
Bereich = "A1:" & ende
For Each zelle In Sheets(x).Range(Bereich)
If zelle = "Zuschlag" Then
Sheets("Sammelblatt").Range("A" & Zeile) = zelle.Offset(0, 1)
Zeile = Zeile + 1
End If
Next
End If
Next x
End Sub

Jedoch möchte ich, dass er mir die Daten nicht von oben nach unten, sondern von rechts nach links schreibt.
Nach nun mehreren Tagen suche komme ich leider nicht weiter. Es wäre nett, wenn mir hierbei jemand helfen könnte.
Danke, Gruß, Mike
PS: Ich nutze seit einigen Monaten Euer Archiv. Ich muss sagen, Ihr habt oft tolle beispiele, von denen ich schon einige umsetzen konnte.
Dafür vielen Dank!

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Alle Tabellenblätter durchsuchen
23.10.2006 14:16:14
fcs
Hallo Mike,
hier ungetest die Anpassung, die von Rechts nach Links die Treffer einsammelt.
Gruß
Franz

Sub Durchlauf()
Dim x As Byte, zelle, Bereich$, Spalte#, SpalteR#, Zeile#, ende$
Zeile = 1
SpalteR = 255 'rechte Spalte in der begonnen werden soll
Spalte = SpalteR
For x = 1 To Sheets.Count
If Not Sheets(x).Name = "Sammelblatt" Then
ende = Sheets(x).Range("A1").SpecialCells(xlLastCell).Address
Bereich = "A1:" & ende
For Each zelle In Sheets(x).Range(Bereich)
If zelle = "Zuschlag" Then
Sheets("Sammelblatt").Cells(Zeile, Spalte) = zelle.Offset(0, 1)
If Spalte = 1 Then
Zeile = Zeile + 1
Spalte = SpalteR
Else
Spalte = Spalte - 1
End If
End If
Next
End If
Next x
End Sub

Anzeige
AW: Alle Tabellenblätter durchsuchen
Mike
Hi Franz.
Vielen Dank für die schnelle Hilfe. Fluppt nach einigen Anpassungen super!
Habe nur ( Spalte = Spalte – 1 in + 1 ) geändert, damit er mir die Daten
von links nach rechts schreibt.
Habe festgestellt dass ich mich in meiner Beschreibung vertan habe.
Gruß, Mike
AW: Alle Tabellenblätter durchsuchen
23.10.2006 15:49:12
Mike
Hi Franz
Hab da noch ne Frage?
Ist es möglich anstelle eines Bezuges, der in das Sammelblatt Kopiert wird,
vielleicht den jeweiligen Tabellennamen in das Sammelblatt zu Kopieren?
Gruß, Mike
AW: Alle Tabellenblätter durchsuchen
23.10.2006 16:28:18
fcs
Hi Mike,
den Tabellennamen kannst du innerhalb der For x = 1 to .... -Next x -Schleife z.B. mit

Sheets(x).Name

ermitteln. Diesen Wert muß du dann in die gewünschte Zelle eintragen. Beispiel:

Sub Durchlauf()
Dim x As Byte, zelle, Bereich$, Spalte#, SpalteR#, Zeile#, ende$
Zeile = 1
SpalteR = 255 'rechte Spalte ab der neue Zeile begonnen werden soll
Spalte = SpalteR
For x = 1 To Sheets.Count
If Not Sheets(x).Name = "Sammelblatt" Then
ende = Sheets(x).Range("A1").SpecialCells(xlLastCell).Address
Bereich = "A1:" & ende
For Each zelle In Sheets(x).Range(Bereich)
If zelle = "Zuschlag" Then
Sheets("Sammelblatt").Cells(Zeile, Spalte) = Sheets(x).Name
Sheets("Sammelblatt").Cells(Zeile+1, Spalte) = zelle.Offset(0, 1)
If Spalte = SpalteR Then
Zeile = Zeile + 2
Spalte = 1
Else
Spalte = Spalte + 1
End If
End If
Next
End If
Next x
End Sub

Anzeige
AW: Alle Tabellenblätter durchsuchen
23.10.2006 17:05:53
Mike
Jau... das wars! Und wieder ein Stück weiter.
Vielen Dank!
Gruß, Mike

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige