Tolong dibantu, lagi butuh..

  1. 7 minggu lalu

    Bisa tidak ketika klik Ambil Data muncul seperti tombol browse pilih file gitu, jadi kita bisa pilih mau ambil semua file atau pilih sebagian saja dari workbook lain, lalu data yg ingin kita copy akan muncul di sheet input ini. sudah coba buat tapi masih bug
    terima kasih, atas bantunya...

  2. Option Explicit
    Dim directory As String, fileName As String, sheet As Worksheet, total As Integer
    Dim fd As Office.FileDialog
    Dim kolom As Integer
    Dim baris As Integer
    Sub TextBox2_Click()
    Application.ScreenUpdating = True

    Set fd = Application.FileDialog(msoFileDialogFilePicker)

    With fd
    .AllowMultiSelect = True
    .Title = "PESAN | Pilih Worbook"
    .Filters.Clear

    If .Show = True Then
    fileName = Dir(.SelectedItems(1))

    End If
    End With
    Range("B180").Select
    Selection.End(xlDown).Select
    Selection.End(xlUp).Select
    Range(Cells(Selection.Row + 1, 1), _
    Cells(Selection.Row + 1, 1)).Select
    baris = ActiveCell.Row

    kolom = 1 'B
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Workbooks.Open (fileName)

    'kolom = 6

    'Provinsi
    Workbooks(fileName).Worksheets("data").Range("C2").Copy
    Windows("RUN.xlsb").Activate
    Worksheets("Input").Select
    ActiveCell.Range("b10000").Select
    Selection.End(xlUp).Offset(1, 0).Activate
    ActiveCell.Select
    Selection.PasteSpecial Paste:=xlPasteValues, _
    Operation:=xlNone

    'Kota/Kab
    Workbooks(fileName).Worksheets("data").Range("C3").Copy
    Windows("RUN.xlsb").Activate
    Worksheets("Input").Select
    ActiveCell.Offset(0, 1).Activate
    ActiveCell.Select
    Selection.PasteSpecial Paste:=xlPasteValues, _
    Operation:=xlNone


    'Kecamatan
    Workbooks(fileName).Worksheets("data").Range("C4").Copy
    Windows("RUN.xlsb").Activate
    Worksheets("Input").Select
    ActiveCell.Offset(0, 1).Activate
    ActiveCell.Select
    Selection.PasteSpecial Paste:=xlPasteValues, _
    Operation:=xlNone

    'Kelurahan
    Workbooks(fileName).Worksheets("data").Range("C5").Copy
    Windows("RUN.xlsb").Activate
    Worksheets("Input").Select
    ActiveCell.Offset(0, 1).Activate
    ActiveCell.Select
    Selection.PasteSpecial Paste:=xlPasteValues, _
    Operation:=xlNone

    'ke Kolom B, baris berikut
    ThisWorkbook.Worksheets("Input").Activate
    ActiveCell.Offset(-1, -3).Activate

    Workbooks(fileName).Close

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

    MsgBox "Ambil data Workbook Sukses!", , "Pesan"

    End Sub
    Sub TextBox3_Click()

    End Sub

  3. Teriam kasih mas @joe238
    hanya bisa ambil per satu file ya mas @joe238, kli kita select dua file juga langssung terambil gmn caranya mas, terima kasih sudah sangat membantu mas..

  4. Option Explicit
    Dim directory As String, fileName As String, _
    sheet As Worksheet, total As Integer
    Dim fd As Office.FileDialog
    Dim kolom As Integer
    Dim baris As Integer, F As Integer

    Sub TextBox2_Click()
    Application.ScreenUpdating = True

    Set fd = Application.FileDialog(msoFileDialogFilePicker)


    For F = 1 To _
    InputBox(prompt:="Berapa jumlah file yang ingin disalin?", _
    Title:="Jumlah File", Default:="1,2,3,dst")
    With fd
    .AllowMultiSelect = False
    .Title = "PESAN | Pilih Worbook"
    .Filters.Clear

    If .Show = True Then
    fileName = Dir(.SelectedItems(1))

    End If
    End With


    Range("B180").Select
    Selection.End(xlDown).Select
    Selection.End(xlUp).Select
    Range(Cells(Selection.Row + 1, 1), _
    Cells(Selection.Row + 1, 1)).Select
    baris = ActiveCell.Row

    kolom = 1 'B
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Workbooks.Open (fileName)

    'kolom = 6

    'Provinsi
    Workbooks(fileName).Worksheets("data").Range("C2").Copy
    Windows("RUN.xlsb").Activate
    Worksheets("Input").Select
    ActiveCell.Range("b10000").Select
    Selection.End(xlUp).Offset(1, 0).Activate
    ActiveCell.Select
    Selection.PasteSpecial Paste:=xlPasteValues, _
    Operation:=xlNone

    'Kota/Kab
    Workbooks(fileName).Worksheets("data").Range("C3").Copy
    ActiveCell.Offset(0, 1).Activate
    ActiveCell.Select
    Selection.PasteSpecial Paste:=xlPasteValues, _
    Operation:=xlNone


    'Kecamatan
    Workbooks(fileName).Worksheets("data").Range("C4").Copy
    ActiveCell.Offset(0, 1).Activate
    ActiveCell.Select
    Selection.PasteSpecial Paste:=xlPasteValues, _
    Operation:=xlNone

    'Kelurahan
    Workbooks(fileName).Worksheets("data").Range("C5").Copy
    ActiveCell.Offset(0, 1).Activate
    ActiveCell.Select
    Selection.PasteSpecial Paste:=xlPasteValues, _
    Operation:=xlNone

    'ke Kolom B, baris berikut
    ThisWorkbook.Worksheets("Input").Activate
    ActiveCell.Offset(-1, -3).Activate
    baris = ActiveCell.Row

    Workbooks(fileName).Close
    Next F
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

    MsgBox "Ambil data Workbook Sukses!", , "Pesan"

    End Sub
    Sub TextBox3_Click()

    End Sub

  5. Ok mas @joe238 terima kasih.

 

atau Mendaftar untuk ikut berdiskusi!