ambil data beda workbooks

  1. 5 tahun lalu

    mau tanya agan semua..bagaimana caranya mengambil data beda workbook dengan multiple kondisi misal di file 1 ada tabel a,b,c,d,e,f,g nah pada file 2 ada tabel a,b,c,d,e,f,g,h,i,j nah sy mau mengisi kolom h di file2 yg ada di kolom c pada file1.
    namun utk mendapatkan value kolom c di file1 ini ada 2 kondisi yaitu cek jika kolom d dan kolom f pd file2 ada dan sama pd file1 maka ambil value c pd file1 dan cetak pd kolom h di file 2..
    ada yg bisa bantu bagaimana formulanya dan macronya

    trims.

  2. @ddtopgun

    sebaiknya buat aja contoh filenya dan lampirkan disini

  3. Di sunting 5 tahun lalu oleh ddtopgun

    ini filenya gan ..sekedar tambahan jd di file2 itu jika labelnya pt maka akan mengambil data di file1 dengan nama sheet pt begitu pun yg lainnya sv dan fg akan mengambil data sesuai dengan nama sheetnya tp di lain workbooks..
    bagaimana utk macronya utk mengambil nama sesuai dengan kriteria status dan berat di file1

    trims gan.

  4. @ddtopgun

    coba skrip berikut :

    Option Explicit
    Sub ambildata()
    'tentukan variabel :
    Dim xsh, wb, sh, fTarget
    Dim sel, rng, selTarget, rngTarget
    Set xsh = ThisWorkbook.Worksheets("Sheet1")
    Set rng = xsh.Range("B2:B7")
    
    On Error Resume Next
    'periksa apakah file1 sudah aktif :
    Set wb = Workbooks("file1.xls")
    wb.Activate
    'jika belum maka buka filenya :
    If Err <> 0 Then
        fTarget = ThisWorkbook.Path & "\file1.xls"
        Set wb = Workbooks.Open(fTarget)
    End If
    
    'proses pencarian data :
    For Each sel In rng
        Set sh = wb.Worksheets(sel.Value)
        Set rngTarget = sh.Range("B2:B7")
        For Each selTarget In rngTarget
            If selTarget = sel.Offset(0, 1) And _
               selTarget.Offset(0, 2) = sel.Offset(0, 2) Then
               sel.Offset(0, 3) = selTarget.Offset(0, -1)
               Exit For
            End If
        Next selTarget
    Next sel
    'wb.Close <- kalo mau tutup file1
    End Sub

    note : pastikan kedua file tersebut ada dalam 1 folder

  5. Di sunting 5 tahun lalu oleh ddtopgun

    akan sy coba dl gan..trims .

  6. setelah d coba nama g tampil di file2 dan pd saat di execute macronnya dia membuka file1 dan langsung ke sheet sv

  7. @ddtopgun setelah d coba nama g tampil di file2 dan pd saat di execute macronnya dia membuka file1 dan langsung ke sheet sv

    skripnya di taro di file yg mana?

    cek aja di lampiran, extrak dulu

  8. skrip sy taro di file 2 tapi tidak di modul nya, tapi di sheet1 file2 nya.
    kalau di module nya emng bisa tapi kalau di sheet tidak bisa.

    caranya spy bisa di sheet apa yang harus di ubah y..

  9. @ddtopgun ...kalau di module nya emng bisa tapi kalau di sheet tidak bisa...

    masa sih :)

    @ddtopgun ...caranya spy bisa di sheet apa yang harus di ubah y...

    tidak ada baris skrip yang perlu dirubah, anda hanya perlu menyalin skrip tersebut ke salah satu event worksheet, atau misalnya jika menggunakan command_button activeXcontrol maka :

    Option Explicit
    Private Sub CommandButton1_Click()
    'tentukan variabel :
    .... dst ....
    'wb.Close <- kalo mau tutup file1
    End sub

  10. itu file yg di sheet tetep tidak tampil..mohon bantuannya

    trims

  11. sama ini gan jika kita sdh open file1 trs kita ingin mendapatkan lastrow file2 tapi saat itu wb yg aktif file1 sehingga lastrownya file 2 tidak terbaca..nah bagaimana agar wb file2 yg aktif..

  12. @ddtopgun itu file yg di sheet tetep tidak tampil..mohon bantuannya

    anda merubah beberapa baris skrip dan membuat sedikit kesalahan, silahkan lebih teliti lagi :)

    @ddtopgun ...jika kita sdh open file1 trs kita ingin mendapatkan lastrow file2 tapi saat itu wb yg aktif file1 sehingga lastrownya file 2 tidak terbaca..nah bagaimana agar wb file2 yg aktif..

    kan tinggal dikasih perintah agar file2 aktif, deklarasikan variabel tertentu seperti contoh yang saya berikan (wb = file1) untuk menggantikan file2 agar mudah pada pernulisan skripnya

    saya lagi ada kerjaan, nanti aja saya bantu. untuk saat ini silahkan coba2 sendiri dahulu :P

  13. Set xsh = Workbooks(vFileD).Worksheets("Sheet3")
    Set rng = xsh.Range("G12:G" & LastRow2)


    Set wb = Workbooks("09.IR 01_2019.xlsx")
    wb.Activate
    'jika belum maka buka filenya :
    If Err <> 0 Then
    fTarget = ThisWorkbook.Path & "\09. IR 01_2019.xlsx"
    Set wb = Workbooks.Open(fTarget)
    End If

    'proses pencarian data :
    For Each sel In rng
    Set sh = wb.Worksheets(sel.Value)
    Set rngTarget = sh.Range("G12:G" & LastRow2)
    For Each selTarget In rngTarget
    If selTarget = sel.Offset(0, 7) And _
    selTarget.Offset(0, 12) = sel.Offset(0, 12) Then
    sel.Offset(0, 41) = selTarget.Offset(0, -1)
    Exit For
    End If
    Next selTarget
    Next sel
    wb.Close
    Application.ScreenUpdating = True

    error pd line 1 (subscript out of range)

  14. Set xsh = Workbooks("KMPI-Sales Evaluation 01-2019.xlsm").Sheets("compare 01-19")
    Set rng = xsh.Range("G12:G" & LastRow2)
    On Error Resume Next

    Set wb = Workbooks("09. KMPI - Inventory Report 01_2019.xlsx")
    wb.Activate
    'jika belum maka buka filenya :
    If Err <> 0 Then
    fTarget = ThisWorkbook.Path & "\09. KMPI - Inventory Report 01_2019.xlsx"
    Set wb = Workbooks.Open(fTarget)
    End If

    'proses pencarian data :
    For Each sel In rng
    Set sh = wb.Worksheets(sel.Value)
    Set rngTarget = sh.Range("G12:G" & LastRow2)
    For Each selTarget In rngTarget
    If selTarget = sel.Offset(0, 7) And _
    selTarget.Offset(0, 12) = sel.Offset(0, 12) Then
    sel.Offset(0, 41) = selTarget.Offset(0, -1)
    Exit For
    End If
    Next selTarget
    Next sel
    wb.Close
    Application.ScreenUpdating = True

    sdh tidak error tp hasilnya tidak keluar namanya ..

  15. sy trace atu-atu dengan step into..proses mah berjalan sampe selesai tp g ada hasilnya gan..

  16. Di sunting 5 tahun lalu oleh manweljs_

    @ddtopgun sy trace atu-atu dengan step into..proses mah berjalan sampe selesai tp g ada hasilnya gan..

    coba pastikan 09. KMPI - Inventory Report 01_2019.xlsx dalam keadaan terbuka kemudian disabel dahulu error trap dan beberapa baris dibawahnya, yaitu :

    ...
    'disable dulu :
    'On Error Resume Next
    ...
    'If Err <> 0 Then
    'fTarget = ThisWorkbook.Path & "\09. KMPI - Inventory Report 01_2019.xlsx"
    'Set wb = Workbooks.Open(fTarget)
    'End If
    ...
    'dan ini juga agar file datanya tetap terbuka :
    'wb.Close 
    ...

    kalo sudah coba deh di trace atu-atu dengan step into.. :)

    nanti kalo sudah nyerah baru lampirkan contoh filenya, saya harus mastikan data dan offsetnya apakah sudah benar atau belum. sebenarnya penggunaan offset hanya untuk contoh aja, kalo pada real datanya bisa menggunakan Cells atau Range tergantung selera

  17. ada email gan..?

  18. For Each sel In rng
    ' MsgBox sel
    Set sh = wb.Worksheets(sel.Value)
    Set rngTarget = sh.Range("M6:M" & LastRow2)
    For Each selTarget In rngTarget
    ' MsgBox selTarget
    If selTarget = sel.Offset(0, 6) And selTarget.Offset(0, 26) = sel.Offset(0, 4) Then
    sel.Offset(0, 8) = selTarget.Offset(0, -4)
    Exit For
    End If
    Next selTarget
    Next sel

    sdh di ubah tetep g tampil data nya ..

  19. @ddtopgun ada email gan..?

    kirim aja filenya via PM, buat diskusi baru kemudian pilih nama user yang bisa melihat diskusi tersebut

  20. tanya lagi gan bagaimana jika ingin mendapatkan nama saja dengan 1 kondisi berdasarkan dari status

    trims gan

 

atau Mendaftar untuk ikut berdiskusi!