Excel vba menyalin data dari satu lembar ke lembar lainnya berdasarkan nilai sel

Tutorial ini akan membahas cara menyalin atau memotong seluruh baris data dan menempelkannya ke lembar lain berdasarkan suatu kondisi. Kondisi dalam contoh ini adalah bahwa nilai sel dalam kolom harus lebih besar dari nol. Kami akan melihat dua teknik

• Untuk Loop
• Filter Lanjutan

Masing-masing memiliki kelebihannya

Himpunan data

Ini adalah kumpulan data kami. Lembar kerja dengan data kami disebut In. Sesuai kondisi kami, kami akan memeriksa sel dengan nilai lebih besar dari nol di kolom terakhir. Ada 3 sel dengan nilai nol. Kami tidak ingin memotong baris di mana sel-sel ini ada. . Semua baris data lainnya akan ditempelkan ke lembar kerja yang disebut Keluar. Itu sudah memiliki tajuk kolom

Untuk Loop

Kami akan mengulangi seluruh kumpulan data. Kami akan menggunakan pernyataan If untuk memeriksa apakah nilai sel saat ini di Col G lebih besar dari 0. Jika ya, kami akan menyalin/memotong data dari seluruh baris dan menempelkannya ke baris berikutnya yang tersedia di lembar Keluar

Sub Solution_For_Loop[]

Dim wsIn As Worksheet, wsOut As Worksheet
Set wsIn = ThisWorkbook.Sheets["In"]
Set wsOut = ThisWorkbook.Sheets["Out"]

wsOut.Range["A2:G" & wsOut.Rows.Count].Clear

Dim lrowIn As Long
lrowIn = wsIn.Range["A1"].CurrentRegion.Rows.Count
Dim lrowOut As Long
Dim i As Long
For i = 2 To lrowIn
    If wsIn.Range["G" & i].Value > 0 Then
        lrowOut = wsOut.Range["A1"].CurrentRegion.Rows.Count + 1
        'wsIn.Range["A" & i & ":G" & i].Copy wsOut.Cells[lrowOut, 1]
        wsIn.Range["A" & i & ":G" & i].Cut wsOut.Cells[lrowOut, 1]
    End If
Next i
End Sub

Sebelum kita melanjutkan solusi berikutnya, mari kita bahas batasan For Loop. Dengan meningkatnya dataset, waktu operasi akan meningkat. Pada dataset yang lebih besar e. g. seratus ribu baris dan seratus kolom, loop for ini bahkan bisa digantung

Jika Anda ingin mempertahankan logika yang sama, tetapi meningkatkan kecepatan, Anda dapat memuat dataset ke dalam loop array dinamis sebagai gantinya

Tapi, untuk kumpulan data yang lebih kecil, itu tidak masalah. Saya akan selalu menyatakan bahwa Anda dapat melakukan hampir semua hal di VBA menggunakan pernyataan For Loop dan If. Teknik lain apa pun hanyalah icing

Baik. Solusi 1 adalah cara terbaik untuk Memotong dan Menempelkan data. Namun, jika Anda ingin menyalin dan menempelkan data, maka cara terbaik untuk melakukannya adalah Filter Lanjutan

Filter Lanjutan

Filter lanjutan memungkinkan kami untuk memfilter rentang data berdasarkan kriteria tertentu dan kami dapat memilih untuk memfilter dalam kumpulan data yang ada atau menempelkan hasilnya di lembar kerja terpisah

Ada 3 elemen untuk Filter Lanjutan

• Rentang Daftar
• Rentang Kriteria
• Salin Ke Rentang

Rentang kriteria akan mencakup kriteria yang ingin kita filter. Itu harus menyertakan Header Kolom atau Kolom yang ingin kita filter

Untuk latihan ini, kita perlu membuat rentang Kriteria. Mari kita buat di lembar kerja In yang sama. Di kolom J, pertama-tama mari kita tempelkan nama tajuk Total Dibebankan, karena ini adalah kolom dengan kondisi kita. Nama header dalam rentang kriteria harus cocok dengan nama header dalam rentang daftar. Di baris berikutnya, kita perlu memasukkan kondisi kita. Ini harus masuk dalam tanda kutip ganda

“>0”

Dan itu saja untuk rentang kriteria. Kami dapat menambahkan lebih banyak kondisi di dalam kolom ini atau bahkan, lebih banyak kolom dengan kondisi. Tapi, itu topik untuk video lain

Dan terakhir, Salin ke Rentang kami adalah Rentang tempat kami ingin menempelkan hasil kami. Ini hanya akan menjadi baris tajuk dari lembar Keluaran

Di VBA, kode untuk mentransfer hasil hanya satu baris

Deklarasikan dan atur variabel rentang untuk menampung ketiga rentang

Filter Lanjutan adalah metode objek jangkauan. Rentang yang ingin kami rujuk adalah rentang Daftar kami

Saya memodifikasi jawaban pengguna3598756 di atas untuk melewati batasan pada panjang maksimal yang diizinkan untuk nama lembar. Ini akan menggabungkan 13 karakter pertama dan terakhir dari nama dengan 4 titik di antaranya

Option Explicit

Sub CopyRows[]
    Dim rngCell As Range
    Dim depSheet As Worksheet
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    With Worksheets["DATA"] '