Simpan beberapa data ke file Lain macro

  1. 2 minggu lalu
    Di sunting 2 minggu lalu oleh mumuskh

    Assalamualaikum War. Wab
    Mau tanya, kira2 apa yang kurang?, nyimpan ke file lain dari baris 4 sampai 23 tidak bisa, mohon pencerahannya dan kami lampirkan filenya.
    Terimakasih sebelumnya.

    Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    If IsFileOpen("G:\TEST\Data.xlsx") Then
    MsgBox "Maaf, file 1.xlsx sedang dibuka, silahkan tutup file terlebih dahulu.."
    Exit Sub
    End If

    Workbooks.Open FileName:="G:\TEST\Data.xlsx"

    With Worksheets("Sheet1")
    BarisTerakhir = .Cells(.Rows.Count, 1).End(xlUp).Row
    For i = 1 To 8

    .Cells(BarisTerakhir + 1, i).Value = Me.Cells(4, i).Value

    Next i
    End With

    Workbooks("Data.xlsx").Save
    Workbooks("Data.xlsx").Close

    Application.ScreenUpdating = True
    End Sub
    Function IsFileOpen(FileName As String)
    Dim iFilenum As Long
    Dim iErr As Long

    On Error Resume Next
    iFilenum = FreeFile()
    Open FileName For Input Lock Read As #iFilenum
    Close iFilenum
    iErr = Err
    On Error GoTo 0

    Select Case iErr
    Case 0: IsFileOpen = False
    Case 70: IsFileOpen = True
    Case Else: Error iErr
    End Select

    End Function

    Terima kasih banyak pencerahannya @manweljs_

  2. manweljs_

    Jun 29 Terverifikasi + 9.854 Poin

    @mumuskh

    jika yang dimaksud :
    1.BarisTerakhir adalah nilai baris akhir dari Sheet1 di file Data.xlsx
    2.Data yang ingin disalin adalah data dari workbook yang aktif di sheet1 range A4:H23 ke baris terakhir di sheet1 workbook Data.xlsx maka :

    ...
    Dim wb As Workbook
    Set wb = Workbooks.Open("G:\TEST\Data.xlsx")
    
    With wb.Worksheets("Sheet1")
    BarisTerakhir = .Cells(.Rows.Count, 1).End(xlUp).Row
    thisworkbook.sheets("Sheet1").range("A4:H23").copy .cells(BarisTerakhir  + 1,1)
    End With
    ...

  3. Di sunting 2 minggu lalu oleh mumuskh

    betul sekali, terima kasih pencerahannya @manweljs_
    tp ada yg kurang faham dikit, klo pastenya spesial sekiranya rumusnya mati gimana perintahnya?

  4. manweljs_

    Jun 29 Terverifikasi + 9.854 Poin
    Di sunting 2 minggu lalu oleh manweljs_

    @mumuskh ...klo pastenya spesial sekiranya rumusnya mati gimana perintahnya?

    saya gak paham apa itu 'rumusnya mati', kalo mau paste special, edit menjadi :

    ...
    thisworkbook.sheets("Sheet1").range("A4:H23").copy 
    .cells(BarisTerakhir  + 1,1).PasteSpecial
    ...

    kalo ingin jadi value :

    ...
    thisworkbook.sheets("Sheet1").range("A4:H23").copy 
    .cells(BarisTerakhir  + 1,1).PasteSpecial Paste:=xlPasteValues
    ...

    demikian

  5. mumuskh

    Jun 29 Jawaban Terpilih + 332 Poin

    Terima kasih banyak pencerahannya @manweljs_

  6. Di sunting 2 minggu lalu oleh mumuskh

    Mohon maaf @manweljs_ ada yg kurang faham
    stlh sy coba test printah yang diatas, save dari file Form.xlsm ke file data.xlsx, mohon solusinya supaya data yang tersimpan di data.xlsx tidak ada baris kosong
    Terima kasih

  7. manweljs_

    Jun 30 Terverifikasi + 9.854 Poin
    Di sunting 2 minggu lalu oleh manweljs_

    @mumuskh

    coba edit menjadi :

    ...
    Dim wb As Workbook, ws As Worksheet
    Set wb = Workbooks.Open("G:\TEST\Data.xlsx")
    Set ws = ThisWorkbook.Sheets("Sheet1")
    
    With wb.Worksheets("Sheet1")
    baristerakhir = .Cells(.Rows.Count, 1).End(xlUp).Row
    ws.Range("A4:H" & ws.Range("A:A").Find("*", , , , xlByRows, xlPrevious).Row).Copy
    .Cells(baristerakhir + 1, 1).PasteSpecial Paste:=xlPasteValues
    End With
    Workbooks("Data.xlsx").Close True
    ...

  8. Maaf @manweljs_
    setelah kami test, hasil data yang terimapan di file data.xlsx masih loncat seperti gambar berikut :
    terima banyak kasih pencerahannya

  9. manweljs_

    Jun 30 Terverifikasi + 9.854 Poin

    @mumuskh

    kok disaya bisa ya :)

    coba tambahi LookIn nya xlValues :

    ...
    ws.Range("A4:H" & ws.Range("A:A").Find("*", , xlValues, , xlByRows, xlPrevious).Row).Copy
    ...

    tes ajja.gif

  10. Di sunting 2 minggu lalu oleh mumuskh

    Sudah sukses, terima kasih banyak pencerahan dan ilmunya @manweljs_

 

atau Mendaftar untuk ikut berdiskusi!