copy rumus dengan kondisi

  1. 4 bulan yang lalu

    Dear Master.......
    Mohon dapat dibantu soal dalam file terlampir, yaitu cara mengcopy rumus dengan macro untuk semua sheet yang ada dengan beberapa kondisi apabila di coloum H:H berisi angka dan tidak kosong dan di coloum J:j tidak terdapat huruf.

    mohon dapat diberikan pencerahan...

    terima kasih atas bantuannya

  2. manweljs_

    Jul 18 Terverifikasi + 5.825 Poin
    Di sunting 4 bulan yang lalu oleh manweljs_

    @nafis2006

    coba skrip berikut :

    Sub CopyFormula()
    Dim sh As Worksheet
    Dim Vol As Range, sel As Range
    
    For Each sh In ActiveWorkbook.Worksheets
        If sh.Name <> "MASTER" Then
        lrow = sh.Range("H" & Rows.Count).End(xlUp).Row
        Set Vol = sh.Range("H10:H" & lrow)
            For Each sel In Vol
            
            If sel > 0 And sel.Offset(0, 2) = "" Then
                sh.Cells(sel.Row, 10) = "=VLOOKUP(A" & sel.Row & ",MASTER,5,0)"
                sh.Cells(sel.Row, 11) = "=VLOOKUP(A" & sel.Row & ",MASTER,11,0)"
                sh.Cells(sel.Row, 12) = "=J" & sel.Row & "*H" & sel.Row & ""
                sh.Cells(sel.Row, 13) = "=K" & sel.Row & "*H" & sel.Row & ""
            End If
    
            Next sel
        End If
    Next sh
    End Sub

  3. Dear mas manweljs.....
    terima kasih banyak script nya berfungsi.....

    cuma kalau di running 2 kali pada file yang sama muncul "run-time error 13".... untuk menghilangkannya di script nya
    ditambah apa yah mas....

    terima kasih

  4. manweljs_

    Jul 18 Terverifikasi + 5.825 Poin

    @nafis2006

    coba tambahkan seperti ini

    ....
    On Error Resume Next ' < --- yg ini
    For Each sh In ActiveWorkbook.Worksheets
    .....

  5. Dear mas manweljs.....
    terima kasih banyak script nya berfungsi.....

    tetapi kondisi "H10:H" tetap membaca huruf yah..... tidak khusus angka saja yang boleh muncul rumus

    sekali lagi terima kasih

  6. manweljs_

    Jul 18 Terverifikasi + 5.825 Poin

    @nafis 2006

    jika demikian coba edit menjadi :

    ...
    For Each sel In Vol
            
            If IsNumeric(sel) And sel > 0 And sel.Offset(0, 2) = "" Then ' <-- edit yang ini
    ...
    

  7. Dear mas manweljs.....

    mantap....abis...It's Works...perfect

    met sukses selalu....mas

    dan dimudahkan dalam segala hal.....amien

 

atau Mendaftar untuk ikut berdiskusi!