@manweljs_ @bejo
ada kok. coba cek keterangan di gambar ini
[attachment:5ffc6ab46f4e7]
Malam kak..
Tolong di bantu perbaiki kak rumus yang tepat.
Yaitu untuk kode pemilihan 5 angka dibawahnya..
Buntu udah kak belajarnya... :D
Sub angkadibawah()
Dim target As Range, sh As Worksheet
x = Range("J" & Rows.Count).End(xlUp).Row
Range("NU15:QP" & x).ClearContents '<-- sesuaikan dengan data
Application.Calculation = xlCalculationManual
For r = 15 To x '<-- dari baris 15 sampai baris terakhir
i = 0
j = 0
Set sh = ActiveSheet
idx = sh.Index + 6
n = Cells(r, idx)
'n adalah angka yg dicari di kolom 7/8/9/10 tergantung index sheetnya
'jadi pastikan indexnya sheetnya berurutan Quarry A, B, C, D
' For c = 267 To 361 '<-- kolom JG sampai kolom MW
For c = Range("JP1").Column To Range("NF1").Column '<-- bisa juga seperti ini
If Len(Cells(r, c)) And Cells(r, c) = n Then
Set target = Cells(r, c)
i = xC(r) + 1 + j
n1 = target.Offset(1, -1)
Cells(r, i) = n1
If Len(n1) Then i = i + 1
n2 = target.Offset(1, -1)
Cells(r, i) = n2
If Len(n1) Then i = i + 1
n3 = target.Offset(1, -1)
Cells(r, i) = n3
If Len(n1) Then i = i + 1
n4 = target.Offset(1, 0)
Cells(r, i) = n4
i = i + 1
n5 = target.Offset(1, 1)
Cells(r, i) = n5
j = 1
End If
Next c
Next r
Application.Calculation = xlCalculationAutomatic
End Sub
Function xC(ByVal r As Long)
'ini untuk cari kolom terakhir, karena menggunakan table jadi End(xlToLeft) nya 2 kali
xC = Cells(r, Columns.Count).End(xlToLeft).End(xlToLeft).Column
'kalau tidak menggunakan excel table cukup seperti ini :
'xC = Cells(r, Columns.Count).End(xlToLeft).Column
End Function