Monday, May 13, 2019

Form VBA Membuat Banyak sheet sekaligus


Private Sub CommandButton1_Click()
Call Hapus
Sheets("data").Range("A6:k110").Value = ""
a = Val(TextBox1.Text)
b = TextBox2.Value
c = a + 5
    No = 0
For NOMOR = 1 To a
No = No + 1
Cells(No + 5, 1).Value = No
Next NOMOR

For i = 6 To c
Cells(i, 2) = b
Next i

[k6:k106].Formula = "=CONCATENATE(b6, a6)"
Application.DisplayFormulaBar = False

'copy filter dan buat sheet baru

Dim sheetCopy As Worksheet
Dim sheetPaste As Worksheet
Dim sheetBuat As Worksheet
Dim Rng As Range

Set sheetCopy = ThisWorkbook.Worksheets("Data")
Set Rng = sheetCopy.Range("c5")

Dim iRowAwal As Integer
Dim iRowAkhir As Integer
Dim iRowTujuan As Integer
Dim sheetFilter As String
Dim sheetSama As Boolean

iRowAkhir = sheetCopy.Cells(sheetCopy.Rows.Count, 1).End(xlUp).Row
For iRowAwal = Rng.Row To iRowAkhir
sheetSama = False
sheetFilter = sheetCopy.Cells(iRowAwal, 11).Text
     For Each sheetBuat In ThisWorkbook.Worksheets
      If sheetFilter = sheetBuat.Name Then
            Set sheetPaste = sheetBuat
            sheetSama = True
            Exit For
        End If
    Next
    If Not sheetSama Then
        Set sheetPaste = ThisWorkbook.Worksheets.Add(before:=sheetCopy)
        sheetPaste.Name = sheetFilter
    End If
    sheetCopy.Rows(5).Copy sheetPaste.Rows(5)
    iRowTujuan = sheetPaste.Cells(sheetPaste.Rows.Count, 1).End(xlUp).Row
    sheetCopy.Rows(iRowAwal).Copy sheetPaste.Rows(iRowTujuan + 1)
Next iRowAwal
sheetCopy.Select
Set Rng = Nothing
Set sheetCopy = Nothing
Sheets("data").Range("A6:k110").Value = ""
Unload Me
Sheets("data").Select
End Sub

Private Sub CommandButton2_Click()
Dim sheet As Worksheet
Application.DisplayAlerts = False
For Each sheet In ThisWorkbook.Worksheets
If LCase(sheet.Name) <> "data" Then sheet.Delete
Next
Application.DisplayAlerts = True
Sheets("data").Range("O1:O200").Value = ""
Unload Me
End Sub


Private Sub ListBox1_Click()
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
End Sub

Private Sub TextBox1_Change()
If TextBox1 = vbNullString Then Exit Sub
If Not IsNumeric(TextBox1) Then
MsgBox "Maaf, hanya data berupa angka yang diijinkan", 16, "Validasi"
TextBox1 = vbNullString
End If
End Sub



Private Sub UserForm_Initialize()
 For k = 2 To Sheets.Count
        ListBox1.AddItem Sheets(k).Name
    Next
    End Sub

sampel file silahkan unduh pada tautan berikut :
Membuat Banyak Sheet sekaligus

No comments:

Post a Comment

APLIKASI GUDANG VERSI EXCEL VBA

Aplikasi Gudang Sederhana silahkan dikembangkan kritik dan saran membangun selalu kami harapkan FROM ENTRI IURAN BULANA...