record data pakai macro tidak berhasil

  1. 2 bulan yang lalu

    rencananya di sheet IMAN ketika klik new maka beberapa data akan terisi otomatis ke sheet RECORD tapi kok gagal ya
    file terlampir

  2. Caton

    Sep 30 Terverifikasi Indonesia + 19.288 Poin

    @Ucy ...

    Coba scriptnya disusun seperti berikut ini,

    Public Sub SimpanData()
        '+-- Hitung jumlah data kolom ID PROD!
        If Application.CountA(Sheet2.Range("C15:C28")) Then
            Dim xlCell As Range
            Dim lRow As Long
            
            lRow = Sheet6.Cells(Rows.Count, "A").End(xlUp).Row + 1
            With Sheet6.ListObjects(1).Range.Columns(1)
                '+-- Tentukan baris kosong terakhir pada sheet RECORD.
                Set xlCell = .Find(What:="", After:=.Cells(1), LookIn:=xlValues, _
                    SearchOrder:=xlByRows, SearchDirection:=xlNext)
                
                If Not xlCell Is Nothing Then
                    lRow = xlCell.Row - 2
                Else
                    MsgBox "Gagal menentukan baris kosong!"
                    Exit Sub
                End If
            End With
            
            For Each xlCell In Sheet2.Range("C15:C28").Rows
                If Len(xlCell.Value) Then
                    With Sheet6.ListObjects(1).DataBodyRange
                        '+-- Nomor Indeks.
                        .Cells(lRow, 1) = IIf(lRow = 1, 1, lRow)
                        '+-- Tanggal Invoice.
                        .Cells(lRow, 2) = Sheet2.Range("AJ1")
                        '+-- Nomor Produksi.
                        .Cells(lRow, 3) = xlCell.Value
                        '+-- Tanggal DO.
                        .Cells(lRow, 4) = Sheet2.Range("AJ4")
                        '+-- Nomor SO.
                        .Cells(lRow, 5) = Sheet2.Range("AJ5")
                        '+-- Nomor Invoice.
                        .Cells(lRow, 6) = Sheet2.Range("Y2")
                        '+-- ID Customer.
                        .Cells(lRow, 7) = Sheet2.Range("AJ2")
                        '+-- Kuantitas.
                        .Cells(lRow, 8) = Sheet2.Cells(xlCell.Row, "Q").Value
                        '+-- Harga.
                        .Cells(lRow, 9) = Sheet2.Cells(xlCell.Row, "T").Value
                        '+-- Diskon.
                        .Cells(lRow, 10) = Sheet2.Cells(xlCell.Row, "X").Value
                    End With
                    lRow = lRow + 1
                End If
            Next
            
            MsgBox "Data tersimpan!"
        End If
    End Sub

    Mudah-mudahan datanya bisa disimpan.

    Demikian.

 

atau Mendaftar untuk ikut berdiskusi!