VBA Makro

Hallo,
ich suche nach einer Lösung zu folgendem Problem:
Ich habe mehrere Blätter, die die gesuchten Werte in Spalte A ab Zeile 8 enthalten ( #1; #2 etc.)
Auf meinem Hauptblatt wo auch der Makrobutton ist, soll nun per Makro folgendes passieren:
Der zu suchende Begriff #1 steht in B6, er soll nun alle (ausser das aktive) Blätter durchsuchen, den Begriff #1 ( immer in Spalte A) finden und den Wert der beiden nächsten gefüllten Zellen nach rechts, in die Zellen des aktiven Blattes C6 und D6 einfügen und den Blattnamen, wo er den Wert gefunden hat in in die Zelle E6 einfügen.
Danach soll mit dem Begriff #2, der natürlich in B7 steht genauso verfahren werden.
Dann B8, B9 etc.
Habe bisher in keinem Forum etwas ähnliches gefunden.
Vielleicht kann mir hier jemand helfen.
THX in advance

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: VBA Makro

18.04.2009 08:52:14

Hajo_Zi

AW: VBA Makro

18.04.2009 13:36:37

mike

AW: VBA Makro

18.04.2009 15:23:33

Jens

AW: VBA Makro

18.04.2009 15:44:23

GraFri

AW: VBA Makro

18.04.2009 18:40:04

mike

AW: VBA Makro

20.04.2009 07:15:09

GraFri

AW: VBA Makro

21.04.2009 15:12:15

mike

AW: VBA Makro

23.04.2009 09:01:11

mike

AW: VBA Makro

25.04.2009 09:27:50

mike

Hallo
Code in ein Modul.


Sub Suchen()
Dim n As Integer, x As Integer, xZeile As Integer
Dim wasSuchen As String
Dim nichtSuchen As String
Dim JaNein As Boolean
' Startzeile im Blatt 'Ablaufplan'
xZeile = 10
' Tabellenblätter, die nicht durchsucht werden sollen
nichtSuchen = "Ablaufplan, Punktezähler-Allkampf, Punkezähler-schwarz'"
JaNein = False
Application.ScreenUpdating = False
With Sheets("Ablaufplan")
While .Range("B" & xZeile)  ""
wasSuchen = Sheets("Ablaufplan").Range("B" & xZeile).Value
For n = 1 To ThisWorkbook.Sheets.Count
' Tabellenblätter aus 'nichtSuchen' nicht berücksichtigen
If InStr(nichtSuchen, Sheets(n).Name) = False Then
' es wird ab Ziele 8 jede 2. Zeile durchsucht
For x = 8 To Sheets(n).Cells(Rows.Count, 1).End(xlUp).Row Step 2
If Sheets(n).Range("A" & x) = wasSuchen Then
If Sheets(n).Range("C" & x)  "" Then
JaNein = True
.Range("C" & xZeile) = Sheets(n).Range("C" & x)
If Sheets(n).Range("D" & x)  "" Then
.Range("D" & xZeile) = Sheets(n).Range("D" & x)
.Range("E" & xZeile) = Sheets(n).Name
Else
.Range("D" & xZeile) = Sheets(n).Range("E" & x)
.Range("E" & xZeile) = Sheets(n).Name
End If
Else
.Range("C" & xZeile) = Sheets(n).Range("D" & x)
.Range("D" & xZeile) = Sheets(n).Range("E" & x)
.Range("E" & xZeile) = Sheets(n).Name
End If
GoTo Sprungmarke
End If
Next x
End If
Next n
Sprungmarke:
JaNein = False
xZeile = xZeile + 1
Wend
End With
Application.ScreenUpdating = True
End Sub

Bei Fragen einfach mailen.
mfg, GraFri

Beliebteste Forumthreads (12 Monate)

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread