AUTO COPY FILTER DI EXCEL 3

Mata sebenernya dah sepet banget ngelihat komputer karena kerjaan yang berhubungan dari angka dengan baris yang berjibun, tetapi untuk membantu menyegarkan otak aku coba membuat tulisan lagi yang berhubungan dengan excel macro.

Seperti biasa tulisan ini aku buat berdasarkan request dari kerjaan, yang proses kerjanya adalah melakukan copy database yang telah di filter di excel ke workbook yang baru secara otomatis.

Langsung sajah berhubung anak-anak juga dah pada pulang...
kode makronya adalah sebagai berikut :

Option Explicit
Sub ExtractReps()
Dim wb As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim nws As Worksheet
Dim rng As Range
Dim r As Integer
Dim c As Range

'setting database
Set ws1 = Sheets("Sheet1")
Set rng = ws1.Range("A1:E97")

'copy data yang di filter
ws1.Columns("C:C").Copy Destination:=Range("L1")

'setting nilai filter dengan kondisi tidak ada data yang kembar
ws1.Columns("L:L").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("J1"), Unique:=True
r = Cells(Rows.Count, "J").End(xlUp).Row

'copy nama judul di kolom C
Range("L1").Value = Range("C1").Value

'copy database yang difilter ke sheet baru
For Each c In Range("J2:J" & r)
ws1.Range("L2").Value = c.Value
Set ws2 = Sheets.Add
ws2.Move After:=Worksheets(Worksheets.Count)
ws2.Name = c.Value
rng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheets("Sheet1").Range("L1:L2"), CopyToRange:=ws2.Range("A1"), Unique:=False
Next
ws1.Select
ws1.Columns("J:L").Delete

'pindahkan sheet hasil copy filter ke workbook baru
For Each ws3 In ThisWorkbook.Worksheets
If ws3.Name <> "Sheet1" Then
If wb Is Nothing Then
ws3.Move
Set wb = ActiveWorkbook
Else
ws3.Move After:=nws
End If
Set nws = ActiveSheet
End If
Next ws3

'mengaktifkan workbook database asal dan membuat filter
ThisWorkbook.Activate
ws1.Range("A1:E1").AutoFilter
ws1.Range("A1").Select
End Sub

Untuk membantu mempermudah mempelajarinya, berikut ini aku lampirkan filenya. silahkan di DOWNLOAD disini.