Note: The other languages of the website are Google-translated. Back to English
English English

Bagaimana cara memindahkan seluruh baris ke lembar lain berdasarkan nilai sel di Excel?

Untuk memindahkan seluruh baris ke lembar lain berdasarkan nilai sel, artikel ini akan membantu Anda.

Pindahkan seluruh baris ke lembar lain berdasarkan nilai sel dengan kode VBA
Pindahkan seluruh baris ke lembar lain berdasarkan nilai sel dengan Kutools for Excel


Pindahkan seluruh baris ke lembar lain berdasarkan nilai sel dengan kode VBA

Seperti gambar di bawah ini yang ditampilkan, Anda perlu memindahkan seluruh baris dari Sheet1 ke Sheet2 jika kata tertentu "Selesai" ada di kolom C. Anda dapat mencoba kode VBA berikut.

1. tekan lain+ F11 tombol secara bersamaan untuk membuka Microsoft Visual Basic untuk Aplikasi jendela.

2. Di jendela Microsoft Visual Basic for Applications, klik Menyisipkan > Modul. Kemudian salin dan tempel kode VBA di bawah ini ke jendela.

VBA code 1: Move entire row to another sheet based on cell value

Sub Cheezy()
'Updated by Kutools for Excel 2017/8/28
    Dim xRg As Range
    Dim xCell As Range
    Dim I As Long
    Dim J As Long
    Dim K As Long
    I = Worksheets("Sheet1").UsedRange.Rows.Count
    J = Worksheets("Sheet2").UsedRange.Rows.Count
    If J = 1 Then
       If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0
    End If
    Set xRg = Worksheets("Sheet1").Range("C1:C" & I)
    On Error Resume Next
    Application.ScreenUpdating = False
    For K = 1 To xRg.Count
        If CStr(xRg(K).Value) = "Done" Then
            xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
            xRg(K).EntireRow.Delete
            If CStr(xRg(K).Value) = "Done" Then
                K = K - 1
            End If
            J = J + 1
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Note: Di dalam kode, Sheet1 adalah lembar kerja berisi baris yang ingin Anda pindahkan. Dan Sheet2 adalah lembar kerja tujuan tempat Anda akan menemukan baris tersebut. “C: C"Adalah kolom yang berisi nilai tertentu, dan kata"Done"Adalah nilai tertentu yang akan Anda pindahkan berdasarkan baris. Silakan ubah sesuai kebutuhan Anda.

3. tekan F5 kunci untuk menjalankan kode, maka baris yang memenuhi kriteria di Sheet1 akan segera dipindahkan ke Sheet2.

Note: Kode VBA di atas akan menghapus baris dari data asli setelah pindah ke lembar kerja yang ditentukan. Jika Anda hanya ingin menyalin baris berdasarkan nilai sel daripada menghapusnya. Silakan terapkan kode VBA di bawah ini 2.

VBA code 2: Copy entire row to another sheet based on cell value

Sub MoveRowBasedOnCellValue()
'Updated by Extendoffice 2017/11/10
    Dim xRg As Range
    Dim xCell As Range
    Dim I As Long
    Dim J As Long
    Dim K As Long
    I = Worksheets("Sheet1").UsedRange.Rows.Count
    J = Worksheets("Sheet2").UsedRange.Rows.Count
    If J = 1 Then
    If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0
    End If
    Set xRg = Worksheets("Sheet1").Range("C1:C" & I)
    On Error Resume Next
    Application.ScreenUpdating = False
    For K = 1 To xRg.Count
        If CStr(xRg(K).Value) = "Done" Then
            xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
            J = J + 1
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Pindahkan seluruh baris ke lembar lain berdasarkan nilai sel dengan Kutools for Excel

Jika Anda pemula dalam kode VBA. Di sini saya perkenalkan Pilih Sel Spesifik kegunaan Kutools untuk Excel. Dengan utilitas ini, Anda dapat dengan mudah memilih semua baris berdasarkan nilai sel tertentu atau nilai sel yang berbeda dalam lembar kerja, dan menyalin baris yang dipilih ke lembar kerja tujuan sesuai kebutuhan. Silakan lakukan sebagai berikut.

Sebelum melamar Kutools untuk Excel, Mohon unduh dan instal terlebih dahulu.

1. Pilih daftar kolom yang berisi nilai sel yang akan Anda pindahkan berdasarkan baris, lalu klik Kutools > Pilih > Pilih Sel Spesifik. Lihat tangkapan layar:

2. Dalam pembukaan Pilih Sel Spesifik kotak dialog, pilih Seluruh baris dalam Tipe pilihan bagian, pilih sama dalam Tipe khusus daftar drop-down, masukkan nilai sel ke dalam kotak teks dan kemudian klik OK .

Lain Pilih Sel Spesifik kotak dialog muncul untuk menunjukkan jumlah baris yang dipilih, dan sementara itu, semua baris berisi nilai yang ditentukan di kolom yang dipilih telah dipilih. Lihat tangkapan layar:

3. tekan Ctrl + C untuk menyalin baris yang dipilih, lalu menempelkannya ke lembar kerja tujuan yang Anda perlukan.

Note: Jika Anda ingin memindahkan baris ke lembar kerja lain berdasarkan dua nilai sel yang berbeda. Misalnya, memindahkan baris berdasarkan nilai sel baik "Selesai" atau "Sedang Diproses", Anda dapat mengaktifkan Or kondisi di Pilih Sel Spesifik kotak dialog seperti gambar di bawah ini yang ditampilkan:

  Jika Anda ingin memiliki uji coba gratis (30 hari) dari utilitas ini, silahkan klik untuk mendownloadnya, lalu lanjutkan untuk menerapkan operasi sesuai langkah di atas.


Terkait artikel:


Alat Produktivitas Kantor Terbaik

Kutools for Excel Memecahkan Sebagian Besar Masalah Anda, dan Meningkatkan Produktivitas Anda hingga 80%

  • Reuse: Masukkan dengan cepat rumus, bagan yang kompleks dan apa pun yang pernah Anda gunakan sebelumnya; Enkripsi Sel dengan kata sandi; Buat Milis dan mengirim email ...
  • Bilah Formula Super (dengan mudah mengedit beberapa baris teks dan rumus); Membaca Tata Letak (membaca dan mengedit sel dalam jumlah besar dengan mudah); Tempel ke Rentang yang Difilter...
  • Gabungkan Sel / Baris / Kolom tanpa kehilangan Data; Pisahkan Konten Sel; Gabungkan Baris / Kolom Duplikat... Mencegah Sel Duplikat; Bandingkan Rentang...
  • Pilih Duplikat atau Unik Baris; Pilih Baris Kosong (semua sel kosong); Temukan Super dan Temukan Fuzzy di Banyak Buku Kerja; Pilih Acak ...
  • Salinan Tepat Beberapa Sel tanpa mengubah referensi rumus; Buat Referensi Otomatis ke Beberapa Lembar; Sisipkan Poin, Kotak Centang, dan lainnya ...
  • Ekstrak Teks, Tambahkan Teks, Hapus berdasarkan Posisi, Hapus Space; Membuat dan Mencetak Subtotal Paging; Konversi Konten Antar Sel dan Komentar...
  • Filter Super (simpan dan terapkan skema filter ke sheet lain); Penyortiran Lanjutan menurut bulan / minggu / hari, frekuensi dan lainnya; Filter Khusus dengan huruf tebal, miring ...
  • Gabungkan Workbooks dan WorkSheets; Gabungkan Tabel berdasarkan kolom kunci; Pisahkan Data menjadi Beberapa Lembar; Konversi Batch xls, xlsx dan PDF...
  • Lebih dari 300 fitur canggih. Mendukung Office / Excel 2007-2019 dan 365. Mendukung semua bahasa. Penerapan yang mudah di perusahaan atau organisasi Anda. Fitur lengkap uji coba gratis 30 hari. Jaminan uang kembali 60 hari.
tab kte 201905

Tab Office Membawa antarmuka Tab ke Office, dan Membuat Pekerjaan Anda Jauh Lebih Mudah

  • Aktifkan pengeditan dan pembacaan tab di Word, Excel, PowerPoint, Publisher, Access, Visio, dan Project.
  • Buka dan buat banyak dokumen di tab baru di jendela yang sama, bukan di jendela baru.
  • Tingkatkan produktivitas Anda hingga 50%, dan kurangi ratusan klik mouse untuk Anda setiap hari!
officetab bawah
Urutkan komentar berdasarkan
komentar (296)
Belum ada peringkat. Jadilah yang pertama memberi peringkat!
Komentar ini diminimalkan oleh moderator di situs
Halo, saya menemukan panduan khusus ini sangat membantu daripada yang lain yang pernah saya lihat. Terima kasih! Masalah yang saya alami adalah jika saya mengubah nilai yang saya inginkan menjadi 'Tutup', saya harus menjalankan F5 untuk memindahkan baris. Saya ingin itu bergerak secara otomatis. Saya baru mengenal Excel sehingga bantuan Anda sangat dihargai. Sub Cheezy() Redupkan xRg As Range Redupkan xCell As Range Redup I Selama Redup J As Long I = Worksheets("ECR Incident Tracker").UsedRange.Rows.Count J = Worksheets("Resolved Issues").UsedRange.Rows. Hitung Jika J = 1 Kemudian Jika Application.WorksheetFunction.CountA(Worksheets("Resolved Issues").UsedRange) = 0 Kemudian J = 0 End If Set xRg = Worksheets("ECR Incident Tracker").Range("B1:B" & I) Pada Kesalahan Resume Next Application.ScreenUpdating = False Untuk Setiap xCell Dalam xRg Jika CStr(xCell.Value) = "Closed" Kemudian xCell.EntireRow.Copy Destination:=Worksheets("Masalah Terselesaikan").Range("A" & J + 1) xCell.EntireRow.Delete J = J + 1 End If Next Application.ScreenUpdating = True End Sub
Komentar ini diminimalkan oleh moderator di situs
Halo, saya mencoba mengotomatiskan pemindahan sel tanpa harus membuka modul dan menekan F5 juga. Apakah Anda pernah menyelesaikan pertanyaan ini? Terima kasih sebelumnya!
Komentar ini diminimalkan oleh moderator di situs
Crystal memberikan informasi tentang cara melakukannya hari ini - lihat halaman satu dari utas ini untuk melihat tanggapannya. Secara otomatis memindahkan baris dengan tanggal hari ini di kolom (L dalam kasus saya) ke lembar kerja yang berbeda.
Komentar ini diminimalkan oleh moderator di situs
Saya menjalankan kode ini dan mencoba memindahkan baris berdasarkan tanggal hari ini yang muncul di kolom I - Saya telah mengubah Range("B1:B" & I) untuk membaca Range(I1:I" & I) . Saya telah mengubah " Selesai" dalam contoh Anda ke Date. Namun, ketika tanggal hari ini muncul di mana saja dalam baris, tidak hanya di kolom I seperti yang diperlukan, baris berpindah ke lembar kerja alternatif. Tahu mengapa hal ini terjadi dan bagaimana saya dapat memindahkan baris hanya ketika tanggal hari ini ada di kolom I, terlepas dari apakah tanggal hari ini muncul di kolom lain?
Komentar ini diminimalkan oleh moderator di situs
Jika saya ingin memiliki banyak nilai dan banyak lembar untuk memindahkan baris saya, saya harus menulis seluruh kode lagi dengan nilai yang berbeda untuk sel itu? Artinya, jika saya memasukkan NA ke dalam satu sel, ia masuk ke lembar Na, dan jika saya memasukkan W# itu akan masuk ke lembar nomor yang salah, dll.
Komentar ini diminimalkan oleh moderator di situs
hai, ini sangat membantu. Apakah ada cara untuk melakukan ini tanpa memindahkan baris data ke lembar kedua, melainkan menyalinnya? Jadi data akan tetap ada di kedua lembar?
Komentar ini diminimalkan oleh moderator di situs
Hai kodenya sangat membantu, tetapi alih-alih menyalin seluruh baris, saya memerlukan pilihan baris tertentu untuk dipindahkan ke lembar berikutnya. bagaimana saya bisa menentukan rentang alih-alih seluruh baris Sub Cheezy() Dim xRg Sebagai Rentang Dim xCell Sebagai Rentang Dim I Selama Dim J Selama I = Worksheets("Sheet1").UsedRange.Rows.Count J = Worksheets(" Sheet2").UsedRange.Rows.Count If J = 1 Kemudian If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Kemudian J = 0 End If Set xRg = Worksheets("Sheet1").Range( "C1:C" & I) On Error Resume Next Application.ScreenUpdating = False Untuk Setiap xCell Di xRg Jika CStr(xCell.Value) = "Done" Kemudian xCell.Semua baris.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1) J = J + 1 End If Next Application.ScreenUpdating = True End Sub
Komentar ini diminimalkan oleh moderator di situs
apa kodenya jika saya ingin menyalin baris (sel tertentu) ke lembar lain ke sel tertentu? TAPI juga berdasarkan nilai Contoh: string gambar produk berwarna blender putih 2 blender putih2 juicer hitam 3 blackjuicer3 tv merah 1 redtv1 besi hijau 4 greeniron4 Saya ingin string disalin ke lembar lain tetapi nomor di kolom gambar menunjukkan berapa kali harus disalin (jadi, dalam hal ini, string blender harus disalin dalam 2 baris
Komentar ini diminimalkan oleh moderator di situs
Hai, Sepotong kode yang sangat bagus, bekerja dengan sangat baik. Bagaimana cara mengubah kode ini untuk memindahkan baris dari satu tabel ke tabel lain, alih-alih satu lembar ke lembar lain? Terimakasih banyak !
Komentar ini diminimalkan oleh moderator di situs
Hai Saya mencoba menggunakan kode tetapi saya menerima kesalahan sintaks pada Dim xCell As Range. Bisakah Anda membantu?
Komentar ini diminimalkan oleh moderator di situs
Sub Cheezy() Redupkan xRg As Range Redupkan xCell As Range Redup I Selama Redup J Selama I = Worksheets("Sheet1").UsedRange.Rows.Count J = Worksheets("Sheet2").UsedRange.Rows.Count If J = 1 Kemudian If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Kemudian J = 0 End If Set xRg = Worksheets("Sheet1").Range("C1:C" & I) Pada Error Resume Selanjutnya Application.ScreenUpdating = False Untuk Setiap xCell Dalam xRg Jika CStr(xCell.Value) = "Selesai" Kemudian xCell.EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1) xCell. EntireRow.Delete J = J + 1 End If Next Application.ScreenUpdating = True End Sub bagaimana cara menambahkan lembar kerja kedua agar baris dipindahkan ke sheet2?
Komentar ini diminimalkan oleh moderator di situs
Apa yang harus saya masukkan jika saya ingin memasukkan tanggal apa pun sebagai nilai saya? Jadi baris tetap di lembar 1 jika tidak memiliki tanggal, dan pindah ke lembar 2 jika ada?
Komentar ini diminimalkan oleh moderator di situs
[quote]hai, ini sangat membantu. Apakah ada cara untuk melakukan ini tanpa memindahkan baris data ke lembar kedua, melainkan menyalinnya? Jadi data akan tetap ada di kedua lembar?Oleh Maddie[/quote] apakah ada yang menyelesaikan ini
Komentar ini diminimalkan oleh moderator di situs
Hapus "xCell.EntireRow.Delete" ini dari kode
Komentar ini diminimalkan oleh moderator di situs
Ketika saya menghapus baris kode itu dan menjalankan makro lagi, Excel membeku. Mengapa dan bagaimana cara memperbaikinya?? Saya ingin data berada di kedua lembar kerja dan tidak dihapus dari aslinya. TIA
Komentar ini diminimalkan oleh moderator di situs
apakah ada jawaban untuk ini? Milik saya juga membeku, saya ingin menyalin tetapi tidak menghapus baris
Komentar ini diminimalkan oleh moderator di situs
Selamat siang,
Kode VBA di bawah ini dapat membantu Anda untuk hanya menyalin baris daripada menghapusnya.

Sub Cheezy()
Redupkan xRg Sebagai Rentang
Redupkan xCell Sebagai Rentang
Redup Aku Selamanya
Dim J Selama
Dim K Selamanya
I = Worksheets("Sheet1").UsedRange.Rows.Count
J = Worksheets("Sheet2").UsedRange.Rows.Count
Jika J = 1 Maka
Jika Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Maka J = 0
End If
Set xRg = Worksheets("Sheet1").Range("C1:C" & I)
On Error Resume Next
Application.ScreenUpdating = Salah
Untuk K = 1 Ke xRg.Hitung
Jika CStr(xRg(K).Nilai) = "Selesai" Maka
xRg(K).EntireRow.Salin Tujuan:=Lembar Kerja("Sheet2").Range("A" & J + 1)
J = J + 1
End If
Next
Application.ScreenUpdating = Benar
End Sub
Komentar ini diminimalkan oleh moderator di situs
Hai, saya sedang mencari variasi untuk ini. Saya perlu skrip untuk berjalan terus menerus, atau gagal setiap kali nilai di bidang spesifik itu berubah. Kode itu sendiri berfungsi tetapi perlu dijalankan secara independen. Saya ingin itu otomatis. Adakah yang bisa membantu?

Selain itu, jika saya hanya ingin menyalin sel tertentu dalam rentang, bagaimana cara melakukannya?
Komentar ini diminimalkan oleh moderator di situs
Rob yang terhormat,

Jika Anda memerlukan skrip untuk berjalan secara otomatis ketika sel di bidang itu berubah, kode VBA di bawah ini dapat membantu Anda. Silakan klik kanan tab lembar saat ini (lembar dengan baris yang akan Anda pindahkan secara otomatis), lalu pilih Lihat Kode dari menu konteks. Kemudian salin dan tempel skrip VBA di bawah ini ke jendela Kode.

Sub Lembar Kerja Pribadi_Rubah (Rentang Target As ByVal)

Redupkan xCell Sebagai Rentang

Redup Aku Selamanya
On Error Resume Next

Application.ScreenUpdating = Salah

Setel xCell = Target(1)
Jika xCell.Value = "Selesai" Maka
I = Worksheets("Sheet2").UsedRange.Rows.Count
Jika saya = 1 Maka

Jika Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Maka I = 0

End If

xCell.EntireRow.Copy Worksheets("Sheet2").Range("A" & I + 1)

xCell.EntireRow.Hapus
End If

Application.ScreenUpdating = Benar

End Sub


Untuk pertanyaan kedua Anda, maksud Anda hanya menyalin beberapa sel alih-alih seluruh baris? Atau bisakah Anda memberikan tangkapan layar dari pertanyaan Anda? Terima kasih!

Salam Hormat, Kristal
Komentar ini diminimalkan oleh moderator di situs
Kristal,


Bantuan Anda lebih dari dibutuhkan :)



Bagaimana kita dapat menambahkan kriteria lain di sini, misalnya saya ingin mentransfer Selesai di samping Selesai:


Sub Lembar Kerja Pribadi_Rubah (Rentang Target As ByVal)

Redupkan xCell Sebagai Rentang

Redup Aku Selamanya
On Error Resume Next

Application.ScreenUpdating = Salah

Setel xCell = Target(1)
Jika xCell.Value = "Selesai" Maka
I = Worksheets("Sheet2").UsedRange.Rows.Count
Jika saya = 1 Maka

Jika Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Maka I = 0

End If

xCell.EntireRow.Copy Worksheets("Sheet2").Range("A" & I + 1)

xCell.EntireRow.Hapus
End If

Application.ScreenUpdating = Benar

End Sub
Komentar ini diminimalkan oleh moderator di situs
Hai Kristal
Ini adalah info paling berguna yang saya temukan di web dan makro ini melakukan apa yang saya inginkan. Tetapi saya memindahkan baris dari satu tabel ke tabel lain - dan dengan makro ini informasi berpindah ke baris bebas pertama di luar tabel, bukan baris bebas berikutnya dalam tabel? Bisakah kamu menolong?
Komentar ini diminimalkan oleh moderator di situs
Saya menjalankan kode ini dan mencoba memindahkan baris berdasarkan tanggal hari ini yang muncul di kolom I - Saya telah mengubah Range("B1:B" & I) untuk membaca Range(I1:I" & I) . Saya telah mengubah " Selesai" dalam contoh Anda ke Date. Namun, ketika tanggal hari ini muncul di mana saja dalam baris, tidak hanya di kolom I seperti yang diperlukan, baris berpindah ke lembar kerja alternatif. Tahu mengapa hal ini terjadi dan bagaimana saya dapat memindahkan baris hanya ketika tanggal hari ini ada di kolom I, terlepas dari apakah tanggal hari ini muncul di kolom lain?
Komentar ini diminimalkan oleh moderator di situs
David terkasih,

Kode berfungsi dengan baik untuk saya setelah mengubah rentang dan nilai variasi hingga saat ini. Format tanggal dalam kode Anda harus sesuai dengan format tanggal yang Anda gunakan di lembar kerja. Atau apakah nyaman bagi Anda untuk melampirkan lembar kerja Anda?
Komentar ini diminimalkan oleh moderator di situs
Hai Kristal,


Saya tidak jelas apa yang Anda maksud ketika Anda mengatakan bahwa format tanggal kode dan spreadsheet harus cocok - saya bukan ahli VB, lebih tingkat pemula. Di spreadsheet saya, saya memasukkan tanggal hari ini di kolom F sebagai tanggal entri baris, dalam format ctrl + :. Saya memasukkan tanggal kedaluwarsa di kolom "I" dengan format bb/hh/tttt. Namun, ini menyebabkan masalah saat membuat entri baris baru dan memasukkan tanggal hari ini di kolom F karena, segera setelah dimasukkan, baris dipindahkan ke lembar kerja baru. Selain itu, kode tambahan untuk dijalankan setiap kali buku kerja dibuka tidak muncul untuk menjalankan tanpa saya memaksa untuk melakukannya. Maaf untuk apa yang mungkin bagi Anda masalah yang sangat sepele, tetapi saya tidak bisa mendengar tentang masalah ini. Bantuan apa pun akan dihargai.
Komentar ini diminimalkan oleh moderator di situs
David terkasih,

Saya telah mencoba persis seperti yang Anda sebutkan di atas, tetapi dosis masalah tidak muncul dalam kasus saya. Bisakah Anda memberikan versi Excel Anda? Saya membutuhkan lebih banyak informasi untuk membantu memecahkan masalah ini. Maaf merepotkanmu lagi.

Salam Hormat, Kristal
Komentar ini diminimalkan oleh moderator di situs
Crystal, ini adalah lembar kerja yang bersangkutan. Anda akan melihat dalam kode yang disalin yang saya cari "hingga" tanggal hari ini di kolom L dan jika "hingga" dan termasuk tanggal hari ini ada di kolom itu maka saya ingin memindahkan baris yang berisi tanggal itu ke lembar kerja baru. Saat ini, ketika saya memasukkan tanggal hari ini di mana saja di baris (misalnya kolom F jika permintaan dikeluarkan hari ini) secara otomatis memindahkan seluruh baris ke spreadsheet yang diarsipkan. Saya biasanya memasukkan tanggal hari ini dengan menggunakan kombinasi ctrl + :, biasanya di kolom F.
Selain itu saya ingin langkah ini terjadi ketika saya membuka buku kerja. Saat ini saya harus pergi untuk menunjukkan kode lalu tekan F5. Setiap saran tentang bagaimana melakukan itu akan disambut.
Komentar ini diminimalkan oleh moderator di situs
Sayangnya buku kerja saya yang diaktifkan makro tidak akan diunggah karena dikatakan format tidak didukung. Ini ada di Excel 2016
Komentar ini diminimalkan oleh moderator di situs
David terkasih,

Kode VBA berikut dapat membantu Anda mencapainya.

Sub Workbook_Open Pribadi ()
Redupkan xRg Sebagai Rentang
Redupkan xCell Sebagai Rentang
Redup Aku Selamanya
Dim J Selama
I = Worksheets("PELUANG OASIS SAAT INI").UsedRange.Rows.Count
J = Worksheets("ARCHIVED OASIS PELUANG").UsedRange.Rows.Count
Jika J = 1 Maka
If Application.WorksheetFunction.CountA(Worksheets("ARCHIVED OASIS OPPORTUNITIES").UsedRange) = 0 Maka J = 0
End If
Set xRg = Worksheets("PELUANG OASIS SAAT INI").Range("L1:L" & I)
On Error Resume Next
Application.ScreenUpdating = Salah
Untuk Setiap xCell Dalam xRg
Jika CStr(xCell.Value) = Tanggal Kemudian
xCell.EntireRow.Copy Destination:=Worksheets("ARCHIVED OASIS OPPORTUNITIES").Range("A" & J + 1)
xCell.EntireRow.Hapus
J = J + 1
End If
Next
End Sub

Catatan:
1. Anda perlu memasukkan skrip VBA ke jendela kode ThisWorkbook;
2. Buku kerja Anda perlu disimpan sebagai Buku Kerja Excel Macro-Enabled.

Setelah operasi di atas, setiap kali Anda membuka buku kerja, seluruh baris akan dipindahkan ke lembar kerja ARCHIVED jika sel di kolom L mencapai tanggal hari ini.

Salam Binatang, Kristal
Komentar ini diminimalkan oleh moderator di situs
Terima kasih kristal,
Ini berfungsi dengan baik jika tanggal hari ini tercapai di kolom L. Apakah ada cara untuk memasukkan tanggal hari ini di kolom L juga, sehingga jika saya tidak memeriksa buku kerja selama beberapa hari, itu akan secara otomatis menyertakan tanggal sebelumnya sebelum hari ini? Terima kasih banyak atas bantuan Anda.
Komentar ini diminimalkan oleh moderator di situs
David terkasih,

Maaf saya tidak yakin saya mendapatkan pertanyaan Anda. Jika demikian, semua baris akan dipindahkan selama tanggal sebelumnya muncul di kolom L?
Komentar ini diminimalkan oleh moderator di situs
Hai Kristal,

Jika saya tidak membuka lembar kerja saya selama beberapa hari dan tanggal yang dimasukkan di kolom L sekarang telah lewat, yaitu tanggal di sel di kolom L adalah 11 September 2017 tetapi tidak membuka lembar kerja saya sampai 13 September, saya akan seperti semua entri di kolom L untuk diperiksa untuk setiap tanggal hingga tanggal hari ini, lalu pindahkan baris yang sesuai ke lembar baru. Saat ini dengan kode yang Anda berikan dengan ramah, hanya baris dengan tanggal saat ini di kolom L yang dipindahkan ke lembar baru meninggalkan yang memiliki tanggal sebelumnya di kolom L, yang saat ini saya pindahkan secara manual ke lembar baru. Terima kasih atas bantuan Anda.
Komentar ini diminimalkan oleh moderator di situs
David terkasih,



Saya mengerti maksud Anda. Silakan coba skrip VBA di bawah ini. Saat membuka buku kerja, semua baris dengan tanggal hingga tanggal hari ini di kolom L akan dipindahkan ke lembar tertentu yang baru.



Sub Workbook_Open Pribadi ()
Redupkan xRg Sebagai Rentang
Redupkan xRgRtn Sebagai Rentang
Redupkan xCell Sebagai Rentang
Redupkan xLastRow Selamanya
Redup Aku Selamanya
Dim J Selama
On Error Resume Next
xLastRow = Lembar Kerja("PELUANG OASIS SAAT INI").UsedRange.Rows.Count
Jika xLastRow < 1 Kemudian Keluar Sub
J = Worksheets("ARCHIVED OASIS PELUANG").UsedRange.Rows.Count
Jika J = 1 Maka
If Application.WorksheetFunction.CountA(Worksheets("ARCHIVED OASIS OPPORTUNITIES").UsedRange) = 0 Maka J = 0
End If
Set xRg = Worksheets("PELUANG OASIS SAAT INI").Range("L1:L" & xLastRow)
Untuk I = 2 Ke xLastRow
Jika xRg(I).Nilai > Tanggal Kemudian Keluar Sub
Jika xRg(I).Nilai <= Tanggal Maka
xRg(I).EntireRow.Copy Destination:=Worksheets("ARCHIVED OASIS OPPORTUNITIES").Range("A" & J + 1)
xRg(I).SeluruhRow.Hapus
J = J + 1
saya = saya - 1
End If
Next
End Sub

Anda perlu meletakkan skrip VBA ke dalam jendela kode ThisWorkbook dan menyimpan buku kerja sebagai Buku Kerja Excel Macro-Enabled.
Komentar ini diminimalkan oleh moderator di situs
Terima kasih Crystal, Itu berfungsi dengan baik.
Komentar ini diminimalkan oleh moderator di situs
Crystal, saya agak tergesa-gesa dalam menanggapi bahwa kodenya berfungsi. Saya membuka buku kerja saya hari ini dan baris yang berisi entri tanggal sebelumnya di sel kolom L masih dalam "lembar kerja peluang oasis saat ini" dan belum pindah ke "lembar kerja oasis yang diarsipkan" seperti yang diharapkan. Adakah ide mengapa hal ini terjadi?
Komentar ini diminimalkan oleh moderator di situs
Sel yang disorot berada di kolom L sehubungan dengan pertanyaan di atas dan merupakan kriteria (hingga tanggal hari ini) untuk memindahkan baris ke lembar kerja baru. Semoga gambar ini membantu.
Komentar ini diminimalkan oleh moderator di situs
Ini juga merupakan salinan dari jendela VBA yang terkait dengan yang di atas.
Komentar ini diminimalkan oleh moderator di situs
Crystal, saya agak tergesa-gesa dalam menanggapi bahwa kodenya berfungsi. Saya membuka buku kerja saya hari ini dan baris yang berisi entri tanggal sebelumnya di sel kolom L masih dalam "lembar kerja peluang oasis saat ini" dan belum pindah ke "lembar kerja oasis yang diarsipkan" seperti yang diharapkan. Adakah ide mengapa hal ini terjadi?
Komentar ini diminimalkan oleh moderator di situs
Kristal,

Karena saya tidak dapat mengunggah buku kerja saya, saya akan mereproduksi baris & kolom di sini

ABCD EFGH IJKL
# Ketik Set-Aside Solicitation Ubah # Tanggal Penerbitan Pertanyaan Lokasi Pengiriman Pelanggan Proposal Proyek Jatuh Tempo

1 SS SB 1234567 1 09/6/17 No Army Name Place Drive Tank 09/10/17

Menggunakan kode di bawah ini, saya ingin memindahkan seluruh baris ke lembar kerja baru ketika kolom L mencapai tanggal hari ini. Juga jika saya belum menyelesaikan lembar kerja selama beberapa hari, saya ingin menggunakan pencarian "sampai hari ini" di kolom L untuk melakukan hal yang sama. Saya juga ingin melakukan ini secara otomatis ketika saya membuka buku kerja jika memungkinkan. Saat ini jika saya memasukkan tanggal hari ini di sel mana pun di baris, misalnya kolom F saat memasukkan data, seluruh baris pindah ke lembar kerja arsip. (Menggunakan Excel 2016)

[Modul 1 Kode]

Sub DaveV()

Redupkan xRg Sebagai Rentang

Redupkan xCell Sebagai Rentang

Redup Aku Selamanya

Dim J Selama

I = Worksheets("PELUANG OASIS SAAT INI").UsedRange.Rows.Count

J = Worksheets("ARCHIVED OASIS PELUANG").UsedRange.Rows.Count

Jika J = 1 Maka
If Application.WorksheetFunction.CountA(Worksheets("ARCHIVED OASIS OPPORTUNITIES").UsedRange) = 0 Maka J = 0

End If

Set xRg = Worksheets("PELUANG OASIS SAAT INI").Range("L1:L" & I)

On Error Resume Next

Application.ScreenUpdating = Salah

Untuk Setiap xCell Dalam xRg

Jika CStr(xCell.Value) = Tanggal Kemudian

xCell.EntireRow.Copy Destination:=Worksheets("ARCHIVED OASIS OPPORTUNITIES").Range("A" & J + 1)
xCell.EntireRow.Hapus

J = J + 1
End If

Next
Application.ScreenUpdating = Benar

End Sub
Komentar ini diminimalkan oleh moderator di situs
[Lembar 1 Kode]

Sub Lembar Kerja Pribadi_Rubah (Rentang Target As ByVal)
Redupkan xCell Sebagai Rentang
Redup Aku Selamanya
On Error Resume Next
Application.ScreenUpdating = Salah
Setel xCell = Target(1)
Jika xCell.Value = Tanggal Kemudian
I = Worksheets("ARCHIVED OASIS OPPORTUNITIES").UsedRange.Rows.Count
Jika saya = 1 Maka
If Application.WorksheetFunction.CountA(Worksheets("ARCHIVED OASIS OPPORTUNITIES").UsedRange) = 0 Kemudian I = 0 End If
xCell.EntireRow.Copy Worksheets("ARCHIVED OASIS OPPORTUNITIES").Range("A" & I + 1)
xCell.EntireRow.Hapus
End If
Application.ScreenUpdating = Benar
End Sub

Semoga di atas membantu tetapi saya bukan orang VBA karena itu tidak mengerti bagaimana membuat kode melakukan apa yang saya butuhkan. Bantuan Anda akan dihargai.
Komentar ini diminimalkan oleh moderator di situs
Ada kesalahan besar dalam skrip Anda!

Katakanlah Anda mendeteksi bahwa baris 7 memiliki kata "Selesai" di kolom C, jadi Anda menyalinnya dan menghapus baris tersebut.
Setelah Anda menghapus baris, baris berikutnya dalam daftar akan menjadi baris 9 dan bukan 8, karena setelah Anda menghapus baris ke-7, sekarang konten baris ke-8 ada di baris 7, dan semua baris naik 1 baris. Jadi baris berikutnya yang harus diperiksa seharusnya adalah baris #8, tetapi sekarang berisi data yang sebelumnya ada di baris #9, jadi setiap kali Anda menghapus satu baris, Anda sebenarnya melewatkan satu baris untuk diperiksa!!!
Komentar ini diminimalkan oleh moderator di situs
Shau ​​Alon yang terhormat,

Terima kasih atas komentarmu. Kode telah diperbarui dengan kesalahan diperbaiki. Terima kasih banyak untuk asisten Anda.

Salam Hormat, Kristal
Komentar ini diminimalkan oleh moderator di situs
Saya pikir ini terjadi pada saya, itu terus menyalin baris yang sama berulang kali meskipun dikatakan kode telah diperbarui. Inilah yang saya miliki:

Sub Cheezy()
'Diperbarui oleh Kutools untuk Excel 2017/8/28
Redupkan xRg Sebagai Rentang
Redupkan xCell Sebagai Rentang
Redup Aku Selamanya
Dim J Selama
Dim K Selamanya
I = Worksheets("PURCHASE FORCAST").UsedRange.Rows.Count
J = Lembar Kerja("Arsip Pembelian").UsedRange.Rows.Count
Jika J = 1 Maka
If Application.WorksheetFunction.CountA(Worksheets("Purchase Archive").UsedRange) = 0 Maka J = 0
End If
Set xRg = Worksheets("PURCHASE FORCAST").Range("H3:H" & I)
On Error Resume Next
Application.ScreenUpdating = Salah
Untuk K = 1 Ke xRg.Hitung
Jika CStr(xRg(K).Nilai) = "Ya" Maka
xRg(K).EntireRow.Tujuan Penyalinan:=Lembar Kerja("Arsip Pembelian").Range("A" & J + 1)
xRg(K).Seluruh Baris.Hapus
Jika CStr(xRg(K).Nilai) = "Ya" Maka
K = K - 1
End If
J = J + 1
End If
Next
Application.ScreenUpdating = Benar
End Sub
Komentar ini diminimalkan oleh moderator di situs
Hai Fred,
Setiap kali Anda menjalankan kode, kode mencari rentang yang ditentukan, jadi kode tersebut menyalin baris yang sama berulang kali karena tidak dapat membedakan baris mana yang telah disalin. Untuk menghindari penyalinan baris yang sama berulang kali, Anda dapat menjalankan kode secara otomatis saat nilai yang cocok dimasukkan dalam sel yang ditentukan.
Pada lembar kerja bernama "PURCHASE FORCAST", klik kanan tab sheet dan klik Lihat kode dari menu konteks. Kemudian salin kode VBA berikut di jendela Sheet (Code).

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Updated by Kutools for Excel 20220830
Dim xRg As Range
Dim xCell As Range
Dim I As Long
Dim J As Long
Dim K As Long
I = Worksheets("PURCHASE FORCAST").UsedRange.Rows.Count
J = Worksheets("Purchase Archive").UsedRange.Rows.Count
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Purchase Archive").UsedRange) = 0 Then J = 0
End If
Set xRg = Worksheets("PURCHASE FORCAST").Range("H3:H" & I)
On Error Resume Next
Application.ScreenUpdating = False
For K = 1 To xRg.Count
If CStr(xRg(K).Value) = "Yes" Then
xRg(K).EntireRow.Copy Destination:=Worksheets("Purchase Archive").Range("A" & J + 1)
xRg(K).EntireRow.Delete
If CStr(xRg(K).Value) = "Yes" Then
K = K - 1
End If
J = J + 1
End If
Next
Application.ScreenUpdating = True
End Sub
Komentar ini diminimalkan oleh moderator di situs
Bisakah seseorang membantu saya membuat ini berfungsi? Saya telah mencoba untuk mengubah bagian yang perlu disesuaikan dengan file saya, tetapi ini muncul dan saya tidak yakin apa yang harus dilakukan.
Komentar ini diminimalkan oleh moderator di situs
katanya file tidak didukung ketika saya mencoba mengunggah file excel. Maaf ... berjuang dengan ini hari ini.
Komentar ini diminimalkan oleh moderator di situs
Saya ingin bantuan untuk tugas serupa, tetapi sedikit berbeda. Saya memiliki 5 kolom angka, sekitar 25000 per kolom, setiap kolom dengan judul 1-5.Saya ingin menyalin seluruh baris ke lembar lain jika nilai kolom 1 lebih besar dari nol, ATAU kolom 2 lebih besar dari nol , ATAU kolom 3 kurang dari nol, ATAU kolom 4 lebih besar dari lima ATAU kolom 5 lebih besar dari dua dll. apakah ini mungkin?
Komentar ini diminimalkan oleh moderator di situs
unggahan gambar tidak berfungsi ... maaf.
Komentar ini diminimalkan oleh moderator di situs
Halo,
Silakan gunakan tombol unggah yang satu ini.
Komentar ini diminimalkan oleh moderator di situs
Jadi tujuannya adalah untuk melihat apakah ada gas yang melebihi batas yang akan saya tetapkan dalam rumus, seluruh telur disalin ke lembar baru.

Terima kasih banyak atas bantuannya.
Komentar ini diminimalkan oleh moderator di situs
Gambar terlampir
Komentar ini diminimalkan oleh moderator di situs
Untuk Michael,
Mungkin Anda bisa mengatasi masalah ini dengan menggunakan add-in Excel. Di sini saya merekomendasikan Anda utilitas Select Specific Cells dari Kutools for Excel. Dengan utilitas ini, Anda dapat dengan mudah memilih semua baris dalam rentang tertentu jika nilai kolom tertentu lebih besar dari atau kurang dari angka. Setelah memilih semua baris yang diperlukan, Anda dapat menyalin dan menempelkannya secara manual ke lembar kerja baru. Lihat di bawah gambar terlampir.

Anda dapat mengetahui lebih banyak tentang fitur ini dengan mengikuti hyperlink di bawah ini.
https://www.extendoffice.com/product/kutools-for-excel/excel-select-specific-cells-rows.html
Komentar ini diminimalkan oleh moderator di situs
terima kasih untuk formula ini, tetapi saya punya masalah yaitu ketika saya ingin memindahkan baris ke lembar lain, itu tidak terjadi secara otomatis. bisakah Anda memberi saya formula lain? jadi setiap kali saya mengubah nilai sel, itu bergerak otomatis.


Terima kasih
Komentar ini diminimalkan oleh moderator di situs
janang yang terhormat,
Dosis kode tidak terjadi secara otomatis sampai Anda memicu tombol run secara manual.
Komentar ini diminimalkan oleh moderator di situs
Hai,

Saya ingin mengatur makro ini tetapi dengan 2 argumen. Saya berhasil membuat makro bekerja di file saya berdasarkan nilai sel di kolom O. Namun saya ingin agar Makro memeriksa apakah Kolom S diisi (atau <> "") juga, sebelum memindahkan baris . Terakhir, saya juga ingin agar baris yang disalin memiliki format yang sama dengan baris di lembar kedua. Apakah itu mengubah makro sepenuhnya?
Komentar ini diminimalkan oleh moderator di situs
Hugues yang terhormat,
Saya tidak tahu apakah saya memahami Anda dengan cara yang benar. Maksud Anda jika sel di kolom S diisi dan sel di Kolom O berisi nilai tertentu secara bersamaan, lalu pindahkan baris dengan pemformatan? Jika tidak, jangan bergerak?
Komentar ini diminimalkan oleh moderator di situs
Halo Kristal,

Ya itulah yang saya maksud. Faktanya, data saya adalah tentang proyek. Kolom saya O adalah status proyek saya, dan S tanggal akhir proyek saya.
Saya ingin pengguna saya, orang-orang yang memiliki informasi dan perlu memasukkannya, untuk dapat "Mengarsipkan" proyek HANYA jika mereka berstatus "Tutup" dan mereka telah memasukkan "Tanggal akhir".


Saya harap ini membantu memperjelas hal-hal
Komentar ini diminimalkan oleh moderator di situs
Hugues yang terhormat,
Maaf untuk membalas begitu terlambat. Kode VBA berikut dapat membantu Anda memecahkan masalah. Silakan ikuti langkah-langkah dalam artikel ini untuk menerapkan skrip VBA.

Sub MoveRowBasedOnCellValue()
Redupkan xRgStatus Sebagai Rentang
Redupkan xRgDate Sebagai Rentang
Redup Aku Selamanya
Dim J Selama
Dim K Selamanya
I = Worksheets("Sheet1").UsedRange.Rows.Count
J = Worksheets("Sheet2").UsedRange.Rows.Count
Jika J = 1 Maka
Jika Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Maka J = 0
End If
Atur xRgStatus = Worksheets("Sheet1").Range("O1:O" & I)
Atur xRgDate = Worksheets("Sheet1").Range("S1:S" & I)
On Error Resume Next
Application.ScreenUpdating = Salah
Application.CutCopyMode = Salah
xRgStatus(1).SeluruhRow.Copy
Worksheets("Sheet2").Range("A" & J + 1).PasteSpecial xlPasteAllUsingSourceTheme
J = J + 1
Untuk K = 2 Ke xRgStatus.Count
Jika CStr(xRgStatus(K).Nilai) = "Tutup" Maka
If (xRgDate(K).Value <> "") Dan (TypeName(xRgDate(K).Value) = "Date") Maka
xRgStatus(K).SeluruhRow.Copy
Worksheets("Sheet2").Range("A" & J + 1).PasteSpecial xlPasteAllUsingSourceTheme
J = J + 1
End If
End If
Next
Application.CutCopyMode = Benar
Application.ScreenUpdating = Benar
End Sub
Komentar ini diminimalkan oleh moderator di situs
Kristal yang terhormat,

Terima kasih banyak atas bantuan Anda!

Salam,

Hugues
Komentar ini diminimalkan oleh moderator di situs
Halo,


Bagaimana cara menyalin baris alih-alih memindahkannya?
Komentar ini diminimalkan oleh moderator di situs
Halo,


Saya tahu ini telah diposting beberapa kali tetapi saya tidak dapat menemukan jawabannya. Bagaimana saya bisa menyalin materi ke lembar baru dan TIDAK menghapusnya dari lembar asli?
Komentar ini diminimalkan oleh moderator di situs
Mike yang terhormat,
Jika Anda ingin menyalin baris alih-alih menghapusnya, kode VBA di bawah ini dapat membantu Anda. Terima kasih atas komentarmu!

Sub Cheezy()
Redupkan xRg Sebagai Rentang
Redupkan xCell Sebagai Rentang
Redup Aku Selamanya
Dim J Selama
Dim K Selamanya
I = Worksheets("Sheet1").UsedRange.Rows.Count
J = Worksheets("Sheet2").UsedRange.Rows.Count
Jika J = 1 Maka
Jika Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Maka J = 0
End If
Set xRg = Worksheets("Sheet1").Range("C1:C" & I)
On Error Resume Next
Application.ScreenUpdating = Salah
Untuk K = 1 Ke xRg.Hitung
Jika CStr(xRg(K).Nilai) = "Selesai" Maka
xRg(K).EntireRow.Salin Tujuan:=Lembar Kerja("Sheet2").Range("A" & J + 1)
J = J + 1
End If
Next
Application.ScreenUpdating = Benar
End Sub
Komentar ini diminimalkan oleh moderator di situs
Hai,

Saya baru menggunakan makro, apakah mungkin untuk menempelkan data di bawah ini setelah nilai tertentu dan akan diulang hingga akhir kolom?
Seperti ini:

Transfer "Biru" setelah "Warna"

A1 = Biru
A5= Warna
A6= (transfer "Biru" di sini)
dan seterusnya...
Komentar ini diminimalkan oleh moderator di situs
John terkasih,
Maksud Anda jika sel berisi "Warna" dalam kolom, lalu salin teks sel pertama ke sel di bawah sel "Warna" dan ulangi salin teks ini hingga akhir kolom?
Belum ada komentar yang diposting di sini
Muat Lebih
Tinggalkan komentar anda
Posting sebagai Tamu
×
Beri peringkat pos ini:
0   Karakter
Lokasi yang Disarankan