Teste mal obs so passt.
Option Explicit
Sub count()
Dim mykeyword, mykeyword2
Dim message As String
Dim lastrow As Long, lastrowmaster As Long, lastcol As Long, i As Long, j As Long
mykeyword = Worksheets("Mastersheet").Cells(2, 19).Value
mykeyword2 = Worksheets("Mastersheet").Cells(3, 19).Value
lastrowmaster = Worksheets("Mastersheet").Cells(Rows.count, 1).End(xlUp).Row
Application.EnableEvents = True
Application.Calculation = xlCalculationManual
For i = 1 To ThisWorkbook.Worksheets.count
With Worksheets(i)
If .Name <> "Mastersheet" Then
lastrow = .Cells(Rows.count, 1).End(xlUp).Row
lastcol = .Cells(8, Columns.count).End(xlToLeft).Column
For j = 8 To lastrow
If .Cells(j, 1).Value = mykeyword Or _
.Cells(j, 1).Value = mykeyword2 Then
Worksheets("Mastersheet").Cells(lastrow + 1, 1).Resize(, lastcol).Value = .Cells(j, 1).Resize(, lastcol).Value
End If
Next
End If
End With
Next
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End Sub
|