Déplacer une ligne d'une feuille à une autre (Move a row from one sheet to another)

[Jakezer]

Bonjour,

J'utilise ce code pour deplacer une ligne d'une feuille (Sheet1) à une autre (Sheet2)
Le code fonctionne mais il deplace la derniere ligne (la derniere dont il y'a un contenu) dans Sheet1 à la derniere ligne dans Sheet2 (qui est 49 par example)
Disant j'ai 5 lignes dans Sheet1 dont y'a un contenu, il va déplacer la 5eme ligne de Sheet1 à la derniere ligne de Sheet2
Moi je veux qu'il déplace les lignes dont la valeur de leurs cellules D est égale à 0 à Sheet2 par ordre normal commençant de A2 et en descendant
Merci d'avance

Sub Deplacer()
    Dim rng As Range
    Dim x As Long
    Dim y As Long
    x = Worksheets("Sheet1").UsedRange.Rows.Count
    y = Worksheets("Sheet2").UsedRange.Rows.Count
    If y = 1 Then
       If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then y = 0
    End If
    Set rng = Worksheets("Sheet1").Range("A" & x)
    On Error Resume Next
    Application.ScreenUpdating = False
    For x = 1 To rng.Count
        If rng("D1").Offset(x, 0).Value = 0 Then
            rng(x).EntireRow.Cut Destination:=Worksheets("Sheet2").Range("A" & y + 1)
            y = y + 1
        End If
    Next
    Application.ScreenUpdating = True
End Sub

 

[Alex Blakenburg]

Thank you so much bro, it is working correctly, but only when am on sheet1, when i open sheet2 it stops and gives me an error: Procedure "Application.Intersect" failed
and it highlights a line in another code where I used application.intersect to test on checkboxes, any idea why is that happening please?

Did you make this change and are still having the error ?

            With srcSht
                .Range(.Cells(x, "A"), .Cells(x, "D")).Cut Destination:=destSht.Range("A" & destLastRow + 1)
            End With

The code above is not calling the sub routine OneSheet which calls the function HasCheckbox which is using Intersect nor is it calling HasCheckbox directly.

Apart from the subroutine Deplacer none of your other code explicitly tells Range what sheet to use, so I think if you are not on the right sheet a lot of the code may appear to be working but is reading/writing to the wrong sheet. When it calls the HasCheckbox function though, the Intersect command errors out because in this line
If Not Application.Intersect(rng, cb.TopLeftCell) Is Nothing Then
cb is looking at Sheet1 and rng is looking at the activesheet which you have set to be Sheet2.

 

[Jakezer]

Have you considered using Autofilter to copy (and delete) all the "0" rows en masse?

Option Explicit
Sub jakezer()
    Dim ws1 As Worksheet, ws2 As Worksheet, lr As Long
    Set ws1 = Sheet1
    Set ws2 = Sheet2
    lr = ws2.Cells(Rows.Count, 1).End(3).Row + 1
 
    With ws1.Cells(1).CurrentRegion
        .AutoFilter 4, "0"
        .Offset(1).Resize(.Rows.Count - 1).Copy ws2.Cells(lr, 1)
        .Offset(1).Resize(.Rows.Count - 1).EntireRow.Delete
        .AutoFilter
    End With
End Sub

This didnt work for me, it moved all rows not only the ones containing 0 in range D, btw how can i make this code work on all columns (without keeping whats in range E) please?

 

[kevin9999]

This didnt work for me, it moved all rows not only the ones containing 0 in range D, btw how can i make this code work on all columns (without keeping whats in range E) please?

I don't quite understand. In post #2 you said "I want it to move the rows whose value of their D cells equals 0 to Sheet2 in normal order starting from A2 and going down" - and the code I provided does just that based on the sample data you provided.

Before running the code, sheet1:

jakezer.xlsb
	A	B	C	D	E
1	Subject	Date	Sender	State	Verification
2	a	6/03/2022	sender	1
3	b	23/03/2022	sender	0
4	c	28/03/2022	sender	1
5	d	28/03/2022	sender	2
6
Sheet1

sheet2:

jakezer.xlsb
	A	B	C	D	E
1	Subject	Date	Sender	State	Verification
2
Sheet2

After running the code, sheet1:

jakezer.xlsb
	A	B	C	D	E
1	Subject	Date	Sender	State	Verification
2	a	6/03/2022	sender	1
3	c	28/03/2022	sender	1
4	d	28/03/2022	sender	2
5
Sheet1

sheet2:

jakezer.xlsb
	A	B	C	D	E
1	Subject	Date	Sender	State	Verification
2	b	23/03/2022	sender	0
3
Sheet2

Anyhow, to copy just columns A-D, change this line of code:

.Offset(1).Resize(.Rows.Count - 1).Copy ws2.Cells(lr, 1)

to this:

.Offset(1).Resize(.Rows.Count - 1,4).Copy ws2.Cells(lr, 1)

 

[Jakezer]

Thanks guys, both solutions work, but in my case i think i have to edit them a little so they can fit perfectly with my work
I posted another thread about this explaining my case with more details

Moving multiple rows from one sheet to another using AutoFilter to cut and delete

Hello, Few days ago I asked for a way to move rows from one sheet to another, got two methods, one with autofilter and one without, The no-autofilter one worked for me but on a single row each time since my code is being refreshed continuesly, didnt work on multiple rows en masse, so am tryna...

www.mrexcel.com