yakni pastikan multyselect bernilai 1
PASTEKAN KODE BERIKUT PADA TOMBOL TAMBAH
For k = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(k) Then
Sheets(ListBox1.List(k)).Select
Sheets(ListBox1.List(k)).Cells.SpecialCells(xlLastCell).Select
Range(Selection, Cells(1, 1)).Select
End If
Next
Dim iRow As Long
iRow = WorksheetFunction.CountA(Range("b:b")) + 5
Cells(iRow, 2).Value = TextBox1.Value
Cells(iRow, 3).Value = TextBox2.Value
Cells(iRow, 4).Value = TextBox3.Value
Cells(iRow, 5).Value = TextBox4.Value
Cells(iRow, 6).Value = TextBox5.Value
Range("A1") = Application.CountA(Range("c6:c100"))
No = 0
For NOMOR = 1 To Range("A1")
No = No + 1
Cells(No + 5, 1).Value = No
Next NOMOR
End Sub
PASTEKAN KODE BERIKUT PADA USERFORM
For k = 1 To Sheets.Count
ListBox1.AddItem Sheets(k).Name
Next
Label1.Caption = Cells(5, 2).Value
Label2.Caption = Cells(5, 3).Value
Label3.Caption = Cells(5, 4).Value
Label4.Caption = Cells(5, 5).Value
Label5.Caption = Cells(5, 6).Value
End Sub
UNDUH SAMPEL FILE xlsm >>>>> disini
semoga bermanfaat
Gak jalan pak kodingnya
ReplyDeleteACTIFKAN MACRO DI KOMPUTERNYA
ReplyDelete