Microsoft Excel

Herbers Excel/VBA-Archiv

VBA worksheet abfrage

Betrifft: VBA worksheet abfrage von: David
Geschrieben am: 30.07.2014 12:58:13

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

  

Betrifft: AW: VBA worksheet abfrage von: Robert
Geschrieben am: 30.07.2014 13:11:25

Hallo David,

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
Bei Fragen einfach melden :)

Viele Grüße
Robert


  

Betrifft: Ungetestet von: Jack_d
Geschrieben am: 30.07.2014 13:13:11

Aber so könnte es aussehen
(Sucht Wert der verschiedenen Zellen in Tabelle 1 in allen tabellen)[ausser in sich selbst]

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
Grüße


  

Betrifft: AW: VBA worksheet abfrage von: Rudi Maintaire
Geschrieben am: 30.07.2014 13:13:49

Hallo,

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

Gruß
Rudi


  

Betrifft: AW: VBA worksheet abfrage von: fcs
Geschrieben am: 30.07.2014 13:27:30

Hallo David,

da muss dann noch eine Schleife über alle Worksheets integriert werden.
Innerhalb der Schleife müssen dann noch die Blätter übersprungen werden, die nicht durchsucht werden sollen.

Gruß
Franz

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



  

Betrifft: AW: VBA worksheet abfrage von: David
Geschrieben am: 30.07.2014 14:05:18

Erstmal einmal ein großes Dankeschön an die schnellen Helfer.
Ich hab die Lösung von "fcs" verwendet und diese funktioniert sehr toll.

Ein Problem habe ich jetzt noch:

Wie kann ich die Formatierung der Zeilen/Spalten in das ausgebende Arbeitsblatt übernehmen?

MfG


  

Betrifft: AW: VBA worksheet abfrage von: fcs
Geschrieben am: 30.07.2014 14:44:35

Hallo David,

wenn möglich dann formatiere die kompletten Spalten in der Zieltabelle in den gewünschten Formaten oder kopiere die Formate aus einer Datentabelle in die Zieltabelle.

wenn zusätzlich individuelle Zellformate übertragen werden sollen, dann muss man die Zellen kopieren statt nur die Werte zu übertragen.

'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

Gruß
Franz


 

Beiträge aus den Excel-Beispielen zum Thema "VBA worksheet abfrage"