Sub count()
totalsheets = Worksheets.count
mykeyword = Worksheets("Mastersheet").Cells(2, 19).Value
mykeyword2 = Worksheets("Mastersheet").Cells(3, 19).Value
Dim message As String
For i = 1 To totalsheets
If Worksheets(i).Name <> "Mastersheet" Then
lastrow = Worksheets(i).Cells(Rows.count, 1).End(xlUp).Row
For j = 8 To lastrow
If Worksheets(i).Cells(j, 1).Value = mykeyword Then
Worksheets("Mastersheet").Activate
lastrow = Worksheets("Mastersheet").Cells(Rows.count, 1).End(xlUp).Row
Worksheets("Mastersheet").Cells(lastrow + 1, 1).Value = Worksheets(i).Cells(j, 1).Value
ElseIf Worksheets(i).Cells(j, 1).Value = mykeyword2 Then
Worksheets("Mastersheet").Activate
lastrow = Worksheets("Mastersheet").Cells(Rows.count, 1).End(xlUp).Row
Worksheets("Mastersheet").Cells(lastrow + 1, 1).Value = Worksheets(i).Cells(j, 1).Value
End If
Next
End If
Next
End Sub
Bin mir nicht sicher wie ich die komplette Zeile kopieren kann, wenn ein Wert stimmt.
|