Dear Prazt; Script berikut adalah hasil record macro, silahkan dicoba, copas kedalam module:
Sub Urutken()
Sheets("kedua").Select
Range("B7:F15").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.Copy
Sheets("ketiga").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("pertama").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("pertama").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("pertama").Sort.SortFields.Add Key:=Range("B6"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("pertama").Sort
.SetRange Range("B6:F14")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Sheets("kedua").Select
Range(Selection, Selection.End(xlToRight)).Select
ActiveWorkbook.Worksheets("kedua").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("kedua").Sort.SortFields.Add Key:=Range("B7"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("kedua").Sort
.SetRange Range("B7:F15")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveSheet.Next.Select
Range(Selection, Selection.End(xlToRight)).Select
ActiveWorkbook.Worksheets("ketiga").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("ketiga").Sort.SortFields.Add Key:=Range("B7"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("ketiga").Sort
.SetRange Range("B7:F15")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("B7").Select
ActiveCell.FormulaR1C1 = "=pertama!R[-1]C"
Range("B7").Select
Selection.Copy
Range("B7:B15").Select
ActiveSheet.Paste
Sheets("kedua").Select
Range("B7:B15").Select
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub
Wassalam
~ Bagus ~
----- Original Message -----
From: PRAZT
To: belajar-excel@yahoogroups.com
Sent: Friday, November 22, 2013 10:47 AM
Subject: RE: [belajar-excel] mengurutkan data beberapa sheet sesui id 1 kali
klik [1 Attachment]
Mentok Mr. Kid...file terlampir mungkin bisa kasih koreksi
From: belajar-excel@yahoogroups.com [mailto:belajar-excel@yahoogroups.com] On
Behalf Of Mr. Kid
Sent: 22 Nopember 2013 07:44
To: BeExcel
Subject: Re: [belajar-excel] mengurutkan data beberapa sheet sesui id 1 kali
klik
Wa'alaikumussalam Wr. Wb.
Sepertinya isi perintahnya begini :
1. loop setiap sheet kecuali sheet pertama, lalu
A. buat semua kolom no.id divalueskan dulu
B. buat semua kolom nama menggunakan fungsi vlookup ke sheet pertama
2. loop setiap sheet termasuk sheet pertama, lakukan sort berdasar no.id
Wassalamu'alaikum Wr. Wb.
Kid.
2013/11/22 PRAZT <praztm...@gmail.com>
Assalamu'alaikum.....
Dear master
Mohon bantuan fikiran untuk menyelesaikan masalah bagaimana caranya
mengurutkan data yang terdiri dari beberapa sheet sesuai no.id dengan satu kali
klik. Ilustrasi ada di file lampiran. terimakasih
PRAZTMATH T
----------------------------------------------------------------------------
Email ini bebas virus dan malware karena avast! Antivirus proteksi
aktif.
------------------------------------------------------------------------------
Email ini bebas virus dan malware karena avast! Antivirus proteksi
aktif.
------------------------------------------------------------------------------
Email ini bebas virus dan malware karena avast! Antivirus proteksi
aktif.
<<image001.gif>>
<<image003.png>>
<<image004.png>>
