VBA If über mehrere Tabellenblätter

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Public Sub bbb() Dim i As Long, raKopie As Range, loLetzte As Long Application.ScreenUpdating = False With Worksheets("Stammdaten") For i = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row If WorksheetFunction.CountIf(Worksheets("Tickets").Columns("G"), .Cells(i, "A")) > 0 _ Then If raKopie Is Nothing Then Set raKopie = .Cells(i, "A") Else Set raKopie = Union(raKopie, .Cells(i, "A")) End If End If Next i End With If Not raKopie Is Nothing Then With Worksheets("Alt Offen") loLetzte = .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Row raKopie.EntireRow.Copy .Cells(loLetzte, "A") End With End If Set raKopie = Nothing End Sub

Danke für eure Hilfe, ich habe jetzt noch eine andere Idee gehabt, da ich noch mehrere If-Bedingungen vorher brauche.
Dim Zeile As Long
Dim ZeileMax As Long
Dim n As Long
Dim Datum As Double
Dim Found As Object
Datum = 43646
With Worksheets("Stammdaten")
ZeileMax = .UsedRange.Rows.Count
n = 2
For Zeile = 2 To ZeileMax
If .Cells(Zeile, 6).Value Like "[99817]*" And .Cells(Zeile, 27).Value = "In Prüfung" Then
Set Found = Worksheets("Stammdaten").Cells(Zeile, 7).Find(Worksheets("Tickets").Columns(1))
If Found Is Nothing Then
.Rows(Zeile).Copy Destination:=Worksheets("Alt In Prüfung").Rows(n)
n = n + 1
Else
.Rows(Zeile).Copy Destination:=Worksheets("Alt Offen").Rows(n)
n = n + 1
End If
End If
Next Zeile
End With
Das Problem hierbei ist, dass er mir die Werte nicht nach "In Püfung" und "Offen" schmeißt sondern alle bei "In Prüfung" landen. Die Werte, die im Blatt Ticktes gefunden werden sollen allerdings ins Blatt "Offen" geschrieben werden. Vielleicht hat jemand von euch zu diesem Problem eine Lösung..
Danke vielmals!

With Worksheets("Stammdaten") ' Dim ZeileMax As Long, n As Long, m As Long, Zeile As Long 'Dim Found As Range ZeileMax = .UsedRange.Rows.Count n = Worksheets("Neu In Prüfung").Cells(Rows.Count, 1).End(xlUp).Row m = Worksheets("Neu Offen").Cells(Rows.Count, 1).End(xlUp).Row For Zeile = 2 To ZeileMax If .Cells(Zeile, 6).Value Like "[99817]*" And .Cells(Zeile, 27).Value = "In Prüfung" _ Then Set Found = Worksheets("Tickets").Columns(1).Find(what:=.Cells(Zeile, 7).value, _ LookIn:=xlValues, LookAt:=xlWhole) If Not Found Is Nothing Then 'NOT wenn die suche erfolgreich war ist Found NICHT _ nothing .Rows(Zeile).Copy Destination:=Worksheets("Neu In Prüfung").Cells(n, 1) n = n + 1 Else .Rows(Zeile).Copy Destination:=Worksheets("Neu Offen").Cells(m, 1) m = m + 1 End If End If Next Zeile Application.CutCopyMode = False End With

Hallo Juls,
ich hoffe deine Bedingungen habe ich richtig umgesetzt. So ganz kapiert hab ich's aber nicht. ;)
Ich gehe davon aus das die Filterung nach der Postleitzahl nicht das Ende der Geschichte sein wird.
Aber die Prüfung geht hier erst nach PLZ, dann nach Status und dann nach Datum.

Sub MaStR()
Dim Zeile As Long, ZeileMax As Long, n As Long, m As Long
Dim Datum As Double, dtCheck As Double
Dim Found As Range
Dim suchwert
Dim sDest As String
Application.ScreenUpdating = False
Datum = Sheets("Start").Range("M9").Value '43646
With Worksheets("Stammdaten")
ZeileMax = .cells(Rows.count,1).end(xlup).row
n = 2
For Zeile = 2 To ZeileMax
sDest = ""
dtCheck = .Cells(Zeile, 10).Value ' inbetriebnahme
suchwert = .Cells(Zeile, 1).Value 'objektnr.
If .Cells(Zeile, 6).Value Like "99817*" Then 'Adresse
Select Case .Cells(Zeile, 27).Value 'status?
Case "Geprüft"
If dtCheck  "" Then
n = Sheets(sDest).Cells(Rows.Count, 1).End(xlUp).Row
If n = 1 Then  .Rows(1).Copy Destination:=Sheets(sDest).Rows(1): Sheets(sDest). _
Columns.AutoFit  'Spaltenüberschriften
.Rows(Zeile).Copy Destination:=Sheets(sDest).Rows(n+1) 'Datenzeile
End If
Next Zeile
Application.ScreenUpdating = True
Application.CutCopyMode = False
End With
End Sub

gruß
rb

Beliebteste Forumthreads (12 Monate)

VBA If über mehrere Tabellenblätter

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

335 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA If über mehrere Tabellenblätter

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

335 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread