cut defined cells from a sheet paste them on another sheet then delete incompletes rows

[Flavien]

Hello Everybody!

My workbook contains 3 sheets.
Feuil1 (=sheet1) this Table is based on an extraction of our ERP.
Feuil2 (=sheet2) this second table is a minutoring table.
"Commandes" sheet allows me to drive the macro
=> ("Transfert de données") to cut/paste selected cells
=> ("Effacer lignes transférées") to delete incompletes rows.

To fill in the 2nd table I need to cut cells of the columns [A;B;C;E;F] from sheet1 and paste them in sheet2 in columns [A;B;C;D;G].
After cutting the cells, I would like to remove the incomplete rows from sheet1.

I can't make a macro that does the operation all at once. Also, the macro that deletes incomplete rows does not delete all rows at once. I have to click several times to clear all rows.

Does anyone have an idea ?

Thank you for your help.

EXAMPLE TRANSFERT & SUPPR LIGNES VIDES.xlsm
	A	B	C	D	E	F	G	H	I
1	N° Plan	Indice	Désignation	sous famille	rédigé par	date	état	N° de plan	Lieu
2	0001	A	lunette	CCC	Fla	18/01/2023	En cours	P8866-C
3	0002	B	lunette	CCC	Fla	19/01/2023		P8866-C
4	0003	C	lunette	CCC	Fla	20/01/2023	En cours	P8866-C
5	0004	A	lunette	CCC	Fla	21/01/2023		P8866-C
6	0005	B	lunette	CCC	Fla	22/01/2023	En cours	P8866-C
7	0006	C	lunette	CCC	Fla	23/01/2023	En cours	P8866-C
8	0007	A	lunette	CCC	Fla	24/01/2023	En cours	P8866-C
9	0008	B	lunette	CCC	Fla	25/01/2023		P8866-C
10	0009	C	lunette	CCC	Fla	26/01/2023		P8866-C
11	0010	A	lunette	CCC	Fla	27/01/2023	En cours	P8866-C
12	0011	B	lunette	CCC	Fla	28/01/2023	En cours	P8866-C
13	0012	C	lunette	CCC	Fla	29/01/2023		P8866-C
14	0013	A	lunette	CCC	Fla	30/01/2023		P8866-C
15	0014	B	lunette	CCC	Fla	31/01/2023	En cours	P8866-C
16	0015	C	lunette	CCC	Fla	01/02/2023		P8866-C
17	0016	A	lunette	CCC	Fla	02/02/2023	En cours	P8866-C
18	0017	B	lunette	CCC	Fla	03/02/2023		P8866-C
19	0018	C	lunette	CCC	Fla	04/02/2023		P8866-C
20	0019	A	lunette	CCC	Fla	05/02/2023		P8866-C
21	0020	B	lunette	CCC	Fla	06/02/2023		P8866-C
22	0021	C	lunette	CCC	Fla	07/02/2023		P8866-C
23	0022	A	lunette	CCC	Fla	08/02/2023		P8866-C
24	0023	B	lunette	CCC	Fla	09/02/2023		P8866-C
25	0024	C	lunette	CCC	Fla	10/02/2023		P8866-C
26	0025	A	lunette	CCC	Fla	11/02/2023		P8866-C
27	0026	B	lunette	CCC	Fla	12/02/2023		P8866-C
28	0027	C	lunette	CCC	Fla	13/02/2023		P8866-C
29	0028	A	lunette	CCC	Fla	14/02/2023		P8866-C
30	0029	B	lunette	CCC	Fla	15/02/2023		P8866-C
31	0030	C	lunette	CCC	Fla	16/02/2023		P8866-C
32	0031	A	lunette	CCC	Fla	17/02/2023		P8866-C
33	0032	B	lunette	CCC	Fla	18/02/2023		P8866-C
34	0033	C	lunette	CCC	Fla	19/02/2023		P8866-C
35	0034	A	lunette	CCC	Fla	20/02/2023		P8866-C
36	0035	B	lunette	CCC	Fla	21/02/2023		P8866-C
37	0036	C	lunette	CCC	Fla	22/02/2023		P8866-C
38	0037	A	lunette	CCC	Fla	23/02/2023		P8866-C
39	0038	B	lunette	CCC	Fla	24/02/2023		P8866-C
40	0039	C	lunette	CCC	Fla	25/02/2023		P8866-C
41	0040	A	lunette	CCC	Fla	26/02/2023		P8866-C
42	0041	B	lunette	CCC	Fla	27/02/2023		P8866-C
Feuil1

EXAMPLE TRANSFERT & SUPPR LIGNES VIDES.xlsm
	A	B	C	D	E	F	G	H	I
1	N° Plan	Indice	Désignation	Pilote	Désignation de l'action	Nos besoins	Date de lancement	Etat	Lieu
2	0001	B		Fla			16/01/2023
3	0003	B		Fla			22/01/2023
4	0005	B		Fla			27/01/2023
5	0006	B		Fla			31/01/2023
6	0007	B		Fla			08/02/2023
7	0010	B		Fla			14/02/2023
8	0011	B		Fla			16/02/2023
9	0014	B		Fla			24/02/2023
10	0016	B		Fla			08/03/2023
11	0241	B		Fla			07/05/2023
12	0243	B		Fla			09/05/2023
13	0245	B		Fla			11/05/2023
14	0246	B		Fla			12/05/2023
15	0247	B		Fla			13/05/2023
16	0250	B		Fla			16/05/2023
17	0251	B		Fla			17/05/2023
18	0254	B		Fla			20/05/2023
19	0256	B		Fla			22/05/2023
20	0300	B		Fla			05/07/2023
Feuil2

 

[Flavien]

Below both macro

[/
Sub transfert()

    Dim Lig As Long, I As Long
    Dim WS1 As Worksheet, WS2 As Worksheet
 
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
 
    Set WS1 = Worksheets("feuil1")
    Set WS2 = Worksheets("feuil2")
    Lig = 2
    For I = 2 To WS1.Range("A" & Rows.Count).End(xlUp).Row
        If WS1.Cells(I, 7) = "En cours" Then
        'If WS1.Cells(I, 8) = "En cours" And WS1.Cells(I, 8) = "texte2" Then
        
            WS1.Cells(I, "A").Cut WS2.Cells(Lig, "A")
            WS1.Cells(I, "B").Cut WS2.Cells(Lig, "B")
            WS1.Cells(I, "C").Cut WS2.Cells(Lig, "C")
            WS1.Cells(I, "E").Cut WS2.Cells(Lig, "D")
            WS1.Cells(I, "F").Cut WS2.Cells(Lig, "G")
            WS1.Cells(I, "C").Cut WS2.Cells(Lig, "C")

            Lig = Lig + 1
        End If
    Next I
 
 
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
End Sub

Sub Supprime_lignes_vides()
Lig = 2

Sheets("feuil1").Select
Dim j As Long
For j = 2 To Sheets("feuil1").Range("A" & Rows.Count).End(xlUp).Row
  If Cells(j, 1) = "" Then Rows(j).Delete
Next j
    End Sub

]

 

[Flavien]

Hello Mr Excel!

Could someone please help me?