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]

If you need to correspond in French you really need to log your question in the Other Language section.
Questions in Other Languages
If you are happy to correspond in English, Google Translate has your question in English as:

"I am using this code to move a row from one sheet (Sheet1) to another (Sheet2) The code works but it moves the last line (the last one with content) in Sheet1 to the last line in Sheet2 (which is 49 for example) Saying I have 5 rows in Sheet1 of which there is content, it will move the 5th row of Sheet1 to the last row of Sheet2 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"

Can you provide an XL2BB of Sheet 1 & 2 and also show what results you are expecting ?
Some things look a bit odd in the code ie
This code really only works if your UsedRange starts in A1

    x = Worksheets("Sheet1").UsedRange.Rows.Count
    Set rng = Worksheets("Sheet1").Range("A" & x)

 

[Peter_SSs]

@Jakezer
Further to Alex's point about which forum to post in:
If you look on the main MrExcel Message Board page you will see under the Excel Questions forum heading "Please post to this forum in English only."
However, I note that you have posted in English before so I will leave your thread in this forum but any further posts in this thread should be in English please.
If you would prefer to have your question in the Questions in Other Languages forum then please post back to say so and I will move it and remove this post and Alex's post so that you thread will show in the Unanswered threads list.

 

[Jakezer]

If you need to correspond in French you really need to log your question in the Other Language section.
Questions in Other Languages
If you are happy to correspond in English, Google Translate has your question in English as:

"I am using this code to move a row from one sheet (Sheet1) to another (Sheet2) The code works but it moves the last line (the last one with content) in Sheet1 to the last line in Sheet2 (which is 49 for example) Saying I have 5 rows in Sheet1 of which there is content, it will move the 5th row of Sheet1 to the last row of Sheet2 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"

Can you provide an XL2BB of Sheet 1 & 2 and also show what results you are expecting ?
Some things look a bit odd in the code ie
This code really only works if your UsedRange starts in A1

    x = Worksheets("Sheet1").UsedRange.Rows.Count
    Set rng = Worksheets("Sheet1").Range("A" & x)

Am sorry @Alex Blakenburg and @Peter_SSs I forgot this was an English forum, not French, how can I edit the post to translate it ?
Here:

file.xlsm
	A	B	C	D	E
1	Subject	Date	Sender	State	Verification
2	a	06/03/2022 14:39	sender	1
3	b	23/03/2022 03:23	sender	0
4	c	28/03/2022 17:56	sender	1
5	d	28/03/2022 23:28	sender	2
6
7
8
9
10
Sheet1

file.xlsm
	A	B	C	D	E
1	Subject	Date	Sender	State	Verification
2
3
4
5
6
7
8
9
10
Sheet2

What am exactly expecting the code to do:
For each row in Sheet1 in which the cell in range D contains the value 0
He cuts that entire row from Sheet1 and moves it to Sheet2
(now the order of that 0 value row in Sheet1 may be messy like shown, but the order in Sheet2 need to be starting from top to bottom)

 

[Alex Blakenburg]

Let's start with this and see where we go from there:
Note: As it stands, this will leave blank lines where you have cut the row from Sheet1

It is quite late here in Australia and I will be login off shortly, so if you can be quite specific on what this is or is not doing then I can make any amendments tomorrow my time.

Sub Deplacer()
    Dim rng As Range
    Dim x As Long
    Dim y As Long
    Dim srcSht As Worksheet
    Dim destSht As Worksheet
    
    Application.ScreenUpdating = False
    
    Set srcSht = Worksheets("Sheet1")
    Set destSht = Worksheets("Sheet2")
    
    x = srcSht.Range("A" & Rows.Count).End(xlUp).Row
    y = destSht.Range("A" & Rows.Count).End(xlUp).Row
       
    Set rng = srcSht.Range("A2:E" & x)
    
    On Error Resume Next
    Application.ScreenUpdating = False
    For x = 2 To rng.Cells.Count
        If srcSht.Cells(x, 4).Value = 0 Then
            srcSht.Cells(x, 4).EntireRow.Cut Destination:=destSht.Range("A" & y + 1)
            y = y + 1
        End If
    Next
    Application.ScreenUpdating = True
End Sub

 

[Jakezer]

Thanks for replying,
This one seems to work fine on Sheet2 it is pasting it on the first empty row, except for, like you said, this will leave blank lines where you have cut the row from Sheet1
I need something to delete that empty row in Sheet1
Why did u choose 4 exactly? I can have more than 4 rows in Sheet1 ?
Btw what should I change to make it cuts only A, B, C and D and it doesn't cut E ranges from Sheet1 ?

 

[Alex Blakenburg]

Ok. The only 4 in my code is in the column position and column 4 is column "D".
Note: These are all the same cell
- Range("D2")
- Cells(2,"D")
- Cells(2,4)

I have made a number of changes so if you can try it again and let me know if it is doing what you need now.

Sub Deplacer_v02()
    Dim rng As Range
    Dim x As Long
    Dim srcLastRow As Long
    Dim destLastRow As Long
    Dim srcSht As Worksheet
    Dim destSht As Worksheet
    
    Application.ScreenUpdating = False
    
    Set srcSht = Worksheets("Sheet1")
    Set destSht = Worksheets("Sheet2")
    
    srcLastRow = srcSht.Range("A" & Rows.Count).End(xlUp).Row
    destLastRow = destSht.Range("A" & Rows.Count).End(xlUp).Row
     
    Set rng = srcSht.Range("A2:E" & srcLastRow)
    
    Application.ScreenUpdating = False
    For x = 2 To srcLastRow
        If srcSht.Cells(x, "D").Value = 0 Then
            srcSht.Range(Cells(x, "A"), Cells(x, "D")).Cut Destination:=destSht.Range("A" & destLastRow + 1)
            srcSht.Cells(x, "D").EntireRow.Delete
            destLastRow = destLastRow + 1
        End If
    Next
    Application.ScreenUpdating = True
End Sub

 

[Jakezer]

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?

 

[Alex Blakenburg]

See if changing this:

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

to this:

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

fixes it.

If not still make that change but I would need to see all the code, since this portion of the code is not using Intersect.

 

[kevin9999]

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