VBA worksheet abfrage

Hallo,
ich hoffe ich bin hier richtig mit meinem Problem und hoffe dass jemand einen Lösungsansatz für mich hat.
Ich bin dabei ein Formular in VBA zu erstellen, mit dem man mehrere Arbeitsblätter durchsucht und wenn in einer bestimmten Spalte ein bestimmter Wert ist, soll die komplette Zeile, in der die Zahl steht, auf ein neues Arbeitsblatt übertragen werden.
Aber anstatt nur in Tabelle 1 zu gucken sollen alle Arbeitsblätter (sind ca 100) durchsucht werden.
Hat jemand vielleicht eine Idee wie das dann geschrieben wird?
Mein Code bisher:

Sub test()
Dim a As Long, i As Long
Application.ScreenUpdating = False
a = 2
For i = 1 To 10000
With Worksheets("Tabelle1")
If .Cells(i, "G") = "1" Then
Worksheets("Tabelle2").Cells(a, 1).Value = Worksheets("Tabelle1").Cells(i, 1).Value
Worksheets("Tabelle2").Cells(a, 2).Value = Worksheets("Tabelle1").Cells(i, 2).Value
Worksheets("Tabelle2").Cells(a, 3).Value = Worksheets("Tabelle1").Cells(i, 5).Value
a = a + 1
Else
End If
End With
Next i
Application.ScreenUpdating = True
End Sub

MfG und Danke im vorraus

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Dim sh As Worksheet Dim Output As Worksheet Dim i As Integer Dim SuchSpalte As Integer Dim SuchWert As String Private Sub test() SuchSpalte = 1 SuchWert = "Suchwert" Set Output = Tabelle1 For Each sh In Worksheets If sh.Name Output.Name Then For i = 1 To sh.UsedRange.SpecialCells(xlCellTypeLastCell).Row If sh.Cells(i, SuchSpalte) = SuchWert Then sh.Rows(i).Copy Output.Cells(Output.UsedRange.SpecialCells(xlCellTypeLastCell).Row, 1).PasteSpecial End If Next i End If Next sh End Sub

Sub test() Dim a As Long, i As Long Dim wrk As Workbook Dim sht As Worksheet Application.ScreenUpdating = False a = 2 For i = 1 To 10000 With Worksheets("Tabelle1") If .Cells(i, "G") = "1" Then For Each sht In wrk.Worksheets If sht.name = "Tabelle1" Then Else With sht .Cells(a, 1).Value = Worksheets("Tabelle1").Cells(i, 1).Value .Cells(a, 2).Value = Worksheets("Tabelle1").Cells(i, 2).Value .Cells(a, 3).Value = Worksheets("Tabelle1").Cells(i, 5).Value a = a + 1 End With End If Next sht Else End If End With Next i Application.ScreenUpdating = True End Sub

Sub test() Dim a As Long, i As Long Dim wks As Worksheet Application.ScreenUpdating = False a = 2 For Each wks In Worksheets If wks.Name "Tabelle2" Then With wks For i = 1 To 10000 If .Cells(i, "G") = "1" Then .Rows(i).Copy Sheets("Tabelle2").Cells(a, 1) a = a + 1 End If Next i End With End If Next End Sub

Sub test() Dim a As Long, i As Long Dim wksZiel As Worksheet, wksQuelle As Worksheet Set wksZiel = ActiveWorkbook.Worksheets("Tabelle2") Application.ScreenUpdating = False a = 2 For Each wksQuelle In ActiveWorkbook.Worksheets Select Case wksQuelle.Name Case wksZiel.Name, "TabeleABCXYZ" 'diese Blätter nicht durchsuchen Case Else With wksQuelle For i = 1 To .Cells(.Rows.Count, 7).End(xlUp).Row If .Cells(i, "G") = "1" Then wksZiel.Cells(a, 1).Value = .Cells(i, 1).Value wksZiel.Cells(a, 2).Value = .Cells(i, 2).Value wksZiel.Cells(a, 3).Value = .Cells(i, 5).Value a = a + 1 Else End If Next i End With End Select Next wksQuelle Application.ScreenUpdating = True End Sub

'Wenn in den Quell-Zellen keine Formeln sind .Range(.Cells(i, 1), .Cells(i, 2)).Copy wksZiel.Cells(a, 1) .Cells(i, 5).Copy wksZiel.Cells(a, 3) 'Wenn in den Quell-Zellen Formeln stehen .Range(.Cells(i, 1), .Cells(i, 2)).Copy With wksZiel.Cells(a, 1) .PasteSpecial Paste:=xlPasteFormats .PasteSpecial Paste:=xlPasteValues End With .Cells(i, 5).Copy With wksZiel.Cells(a, 3) .PasteSpecial Paste:=xlPasteFormats .PasteSpecial Paste:=xlPasteValues End With Application.CutCopyMode = False

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA worksheet abfrage

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread