Makro: Nach Überschr. suchen und in neues AB

Hallo zusammen.
Ich würde mich bei folgendem über Unterstützung freuen.
Ziel:
- Überschrift suchen und spalte markieren. Markiertes dann in neues Arbeitsblatt (z.B. "Z") einfügen (definierte Spalte z.B. immer C).
Konkret: "ASDF" in Überschriften aller Arbeitsblätter (außer "Z") suchen und spalte kopieren. Das kopierte dann in "Z" Arbeitsblatt einfügen (z.B. immer in Spalte C)
Code bisher:


Sub Makro13()
' Makro13 Makro
Cells.Find(What:=" asdf", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
Columns("C:C").Select 'Hier ist der Fehler er soll nicht c:c auswählen sondern die gesuchte  _
_
_
_
Spalte der Überschrift die ich oben gefunden habe
Selection.Copy
Sheets("Tabelle1").Select
ActiveSheet.Paste
End Sub

Probleme:
- Da ich es geklickt habe (Makrorecorder) nimmt er C und nicht die gefundene Spalte zu der gefundenen Zeile.
- Wie kann ich mehrere Begrifffe hintereinander suchen und das Makro durchführen?
Vielen Dank für eure Unterstützung.
Viele Grüße
Nuwajz

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Suchen() Dim WS As Worksheet Dim C For Each WS In Worksheets If WS.Name <> "Z" Then Set C = WS.Rows("1:1").Find("ASDF", LookIn:=xlValues) If Not C Is Nothing Then WS.Columns(C.Column).Copy Sheets("Z").Columns(3).Insert Shift:=xlToRight Application.CutCopyMode = False Else MsgBox "In Blatt '" & WS.Name & "' Nichts gefunden!" End If End If Next End Sub

Sub Suchen() Dim WS As Worksheet Dim C, FFind(), i As Integer FFind = Array("ASDF", "UDD", "AAA") For Each WS In Worksheets If WS.Name <> "Z" Then For i = 0 To UBound(FFind) Set C = WS.Rows("1:1").Find(FFind(i), LookIn:=xlValues) If Not C Is Nothing Then WS.Columns(C.Column).Copy Sheets("Z").Columns(3).Insert Shift:=xlToRight Application.CutCopyMode = False Else MsgBox FFind(i) & " in Blatt '" & WS.Name & "' Nichts gefunden!" End If Next i End If Next End Sub

Sub Suchen() Dim WS As Worksheet Dim C, FFind(), i As Integer FFind = Array("qi106_zulauf_str2_ph_wert", "UDD", "AAA") For Each WS In Worksheets If WS.Name <> "Z" Then For i = 0 To UBound(FFind) Set C = WS.Rows("1:1").Find(FFind(i), LookIn:=xlValues) If Not C Is Nothing Then WS.Columns(C.Column).Copy Sheets("Z").Columns(2).Insert Shift:=xlToRight Application.CutCopyMode = False End If Next i End If Next End Sub

Sub Suchen() Dim WS As Worksheet Dim C, FFind(), FWo(), i As Integer FFind = Array("qi106_zulauf_str2_ph_wert", "UDD", "AAA") FWo = Array(2, 3, 4) 'Zielspalten zu FFind For Each WS In Worksheets If WS.Name <> "Z" Then For i = 0 To UBound(FFind) Set C = WS.Rows("1:1").Find(FFind(i), LookIn:=xlValues) If Not C Is Nothing Then WS.Columns(C.Column).Copy Sheets("Z").Columns(FWo(i)) End If Next i End If Next End Sub

Sub Suchen() Dim WS As Worksheet Dim C, FFind(), NNeu(), FWo(), i As Integer FFind = Array("BLA", "UDD", "AAA", "HUGO") NNeu = Array("qi106_zulauf", "UDD Neu", "AAA", "Neu_HUGO") 'Umbenennung fü FFind FWo = Array(2, 3, 4) 'Zielspalten zu FFind For Each WS In Worksheets If WS.Name <> "Z" Then For i = 0 To UBound(FFind) Set C = WS.Rows("1:1").Find(FFind(i), LookIn:=xlValues) If Not C Is Nothing Then WS.Range(C.Address) = NNeu(i) WS.Columns(C.Column).Copy Sheets("Z").Columns(FWo(i)) End If Next i End If Next End Sub

Option Explicit Sub Suchen() Dim WS As Worksheet Dim C, FFind(), NNeu(), FWo(), i As Integer FFind = Array("BLA", "UDD", "AAA", "HUGO") NNeu = Array("qi106_zulauf", "UDD Neu", "AAANeu", "Neu_HUGO") 'Umbenennung fü FFind FWo = Array(2, 3, 4) 'Zielspalten zu FFind For Each WS In Worksheets If WS.Name <> "Z" Then For i = 0 To UBound(FFind) Set C = WS.Rows("1:1").Find(FFind(i), LookIn:=xlValues) If Not C Is Nothing Then WS.Columns(C.Column).Copy Sheets("Z").Columns(FWo(i)) Sheets("Z").Cells(1, FWo(i)) = NNeu(i) End If Next i End If Next End Sub

Beliebteste Forumthreads (12 Monate)

Makro: Nach Überschr. suchen und in neues AB

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

308 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Makro: Nach Überschr. suchen und in neues AB

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

308 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread