(ask)copy range kondisi baris

  1. 6 hari yang lalu

    selamat malam master, tanya vba copy range...
    disini ad 2 file : "laporan1 dan master pindah"
    bgmna macro ny kalau ingin mengcopy range hnya smpai row79 saja tanpa mengambil data baris subtotal dst,untuk file sebelumnya sesuai karna baris range copy ny baris tsb smpai >100.
    agar mudah 1file "master pindah" utk sy copy & diterapkan di laporan2 berikutnya yg jumlah baris ny berbeda..
    mohon bantuannya

    Aamiin...
    Agar menampilkan dialog open untuk pilih file, ubah scriptnya menjadi seperti ini:

    Sub tarikA1()
    Dim flSource As Variant
    Dim myWbData As Workbook, myData As Worksheet
    Dim myRekap As Worksheet, i As Integer
    flSource = Application.GetOpenFilename(filefilter:="File Excel, *.xl*")
    If flSource = False Then Exit Sub
    Set myWbData = Workbooks.Open(flSource)
    Set myData = myWbData.Sheets("A.1_Update")
    Set myRekap = ThisWorkbook.Sheets("A.1_Update")
    i = myData.Cells(myData.Rows.Count, "C").End(xlUp).Row - 11
    
    myData.Range("C17:T" & i).Copy
    myRekap.Range("C17:T" & i).PasteSpecial (xlPasteAll)
    Application.DisplayAlerts = False
    
    'Tutup Workbook Laporan1
    myWbData.Close
    End Sub

  2. 5 hari yang lalu

    Masdad

    Mar 24 Terverifikasi Demak + 1.364 Poin
    Di sunting 5 hari yang lalu oleh Masdad

    Sebenarnya tinggal cari baris terakhir dikurangi data baris sampai total kalau gak salah ada 11 baris, jadi saya coba pakai script ini untuk yang tarikA1()

    Sub tarikA1()
    Dim myWbData As Workbook, myData As Worksheet
    Dim myRekap As Worksheet, i As Integer
    Set myWbData = Workbooks.Open("E:\BE-ORG\Tes Copy\laporan1.xlsx")
    Set myData = myWbData.Sheets("A.1_Update")
    Set myRekap = ThisWorkbook.Sheets("A.1_Update")
    i = myData.Cells(myData.Rows.Count, "C").End(xlUp).Row - 11
    
    myData.Range("C17:T" & i).Copy
    myRekap.Range("C17:T" & i).PasteSpecial (xlPasteAll)
    Application.DisplayAlerts = False
    
    'Tutup Workbook Laporan1
    myWbData.Close
    End Sub

    Dan untuk tarikA2

    Sub tarikA2()
    Dim myWbData As Workbook, myData As Worksheet
    Dim myRekap As Worksheet, i As Integer
    Set myWbData = Workbooks.Open("E:\BE-ORG\Tes Copy\laporan1.xlsx")
    Set myData = myWbData.Sheets("A.2")
    Set myRekap = ThisWorkbook.Sheets("A.2")
    i = myData.Cells(myData.Rows.Count, "C").End(xlUp).Row - 12
    
    myData.Range("D17:F" & i).Copy
    myRekap.Range("D17:F" & i).PasteSpecial (xlPasteAll)
    
    myData.Range("M17:R" & i).Copy
    myRekap.Range("M17:R" & i).PasteSpecial (xlPasteAll)
    Application.DisplayAlerts = False
    
    'Tutup Workbook Laporan1
    myWbData.Close
    End Sub

    Silahkan dicoba saja :D

  3. makasih master cara nya berhasil menghapus data dari baris terakhir (maklum msh baru belajar macro hehe)..
    kalau pakai fungsi pilih select workbook gmn ya mau mengganti target file selanjutnya tanpa harus rename nama file ny ("E:\BE-ORG\Tes Copy\laporan1.xlsx")..
    semoga mas sehat selalu rezekiny bertambah :)

  4. Masdad

    Mar 24 Terverifikasi Jawaban Terpilih Demak + 1.364 Poin

    Aamiin...
    Agar menampilkan dialog open untuk pilih file, ubah scriptnya menjadi seperti ini:

    Sub tarikA1()
    Dim flSource As Variant
    Dim myWbData As Workbook, myData As Worksheet
    Dim myRekap As Worksheet, i As Integer
    flSource = Application.GetOpenFilename(filefilter:="File Excel, *.xl*")
    If flSource = False Then Exit Sub
    Set myWbData = Workbooks.Open(flSource)
    Set myData = myWbData.Sheets("A.1_Update")
    Set myRekap = ThisWorkbook.Sheets("A.1_Update")
    i = myData.Cells(myData.Rows.Count, "C").End(xlUp).Row - 11
    
    myData.Range("C17:T" & i).Copy
    myRekap.Range("C17:T" & i).PasteSpecial (xlPasteAll)
    Application.DisplayAlerts = False
    
    'Tutup Workbook Laporan1
    myWbData.Close
    End Sub

  5. 4 hari yang lalu

    makasih master masdad telah berbagi ilmunya,(solved)
    sy jd pakai opsi ke-2 open file

  6. 3 hari yang lalu

    Masdad

    Mar 25 Terverifikasi Demak + 1.364 Poin

    Siipp :)

 

atau Mendaftar untuk ikut berdiskusi!