Kode ini akan membantu Anda:
Public Sub debtors()
Dim wkb As Workbook
Dim wks As Worksheet
Dim wksdest As Worksheet
Set wkb = ThisWorkbook
Set wksdest = wkb.Sheets("Sheet7")
wksdest.Rows.Clear 'Clear the contents of Sheet7
destRow = 1 'First row on Sheet7
For i = 1 To 6 'Loop through Sheets 1 to 6
newIndex = Right(Str(i), 1)
thisSheet = "Sheet" + newIndex
Set wks = wkb.Sheets(thisSheet)
wks.Activate
'Selects column I
Columns("I:I").Select
'Find a coincidence with the string "NO"
Set cell = Selection.Find(What:="NO", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
'If there is a coincidence (is Not Nothing)
If Not cell Is Nothing Then
firstRow = cell.Row
newRow = cell.Row
'Copy the row and paste on Sheet7
wks.Rows(newRow).Copy
wksdest.Rows(destRow).PasteSpecial xlPasteValues
destRow = destRow + 1
foundValue = True
'Find next coincidences in the same sheet
While foundValue
Set cell = Selection.FindNext(cell)
If Not cell Is Nothing Then
newRow = cell.Row
If newRow <> firstRow Then
wks.Rows(newRow).Copy
wksdest.Rows(destRow).PasteSpecial xlPasteValues
destRow = destRow + 1
Else
foundValue = False
End If
Else
foundValue = False
End If
Wend
End If
Next i
wksdest.Activate
End Sub
Buka VBA / Macro dengan ALT + F11 , dibawah Buku Kerja Ini masukkan modul baru dan rekatkan kode di sisi kanan.
Jalankan mengklik segitiga hijau.
Saya memberi komentar pada kode untuk membuat Anda mengerti cara kerjanya.
Anda dapat menjalankannya juga langkah demi langkah dengan mengklik pada baris pertama dan kemudian melalui setiap langkah dengan menekan F8 .