cut paste according cell value if row is not hidden

[Flavien]

Hello Every body.

My workbook is composed of 2 sheets.
Sheet 1, I would like to cut rows (only cells of columns A,B,C,E,F) according to a value written on the column G, only if the row is not hidden (filter on column A), then paste cells on the last row of the sheet2 on the columns A,B,C,D,G.
To finish, I'd like to replace the value written in G with "x" and display a message box.

Unfortunately, my macro doesn't work, it copy the head of the first chart on the second line of the second chart.

Sub Transfert()

Dim lig As Long, i As Long
Dim ws1 As Worksheet, ws2 As Worksheet
Dim c As Range
Dim j As Long


Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set ws1 = Worksheets("POLKA")
Set ws2 = Worksheets("SUIVI")
lig = 2

With ws1

For i = 2 To ws1.Range("A" & Rows.Count).End(xlUp).Row
If Not .Rows(i).Hidden Then

If ws1.Cells(i, 7) = "En cours" Then


ws1.Cells(1, "A").Cut ws2.Cells(lig, "A")
ws1.Cells(1, "B").Cut ws2.Cells(lig, "B")
ws1.Cells(1, "C").Cut ws2.Cells(lig, "C")
ws1.Cells(1, "E").Cut ws2.Cells(lig, "D")
ws1.Cells(1, "F").Cut ws2.Cells(lig, "G")

lig = Cells(Rows.Count, 1).End(xlUp).Row

End If

End If

Next i

End With

Worksheets("POLKA").Columns("G").Replace what:="En cours", replacement:="x", lookat:=xlPart

MsgBox "Transfert terminé"

Application.ScreenUpdating = False
Application.DisplayAlerts = False


End Sub

02 - GESTIONNAIRE DES PCP - 01-02-23B.xlsm
	A	B	C	D	E	F	G	H
1	N° de plan / GCU	Indice Plan GCU	Désignation article	Pilote	Désignation de l'action	Nos Besoins	Date de lancement	Etat d'avancement
2	Colonne1	Colonne2	Colonne3	Colonne4			Colonne5
3	3431	A	Maillon latéral fermoir 3R Bracelet	fla	Créer PCP		07/12/2022	5
4	3434	A	AXE EPAULE FERMOIR BRACELET	fla	Créer PCP		23/01/2023
5	3435	C	AXE EPAULE STANDARD BRACELET	fla	Créer PCP		23/01/2023
6	3436	C	AXE PIVOT FERMOIR	fla	Créer PCP		19/12/2022	40
7	3437	A	VIS DE RALLONGE ENCOLLE BRACELET	fla	Créer PCP		23/01/2023
8	3466	D	DESSOUS FERMOIR -bracelet montre mini	fla	Créer PCP		21/12/2022	40
9	3607	B	Bague H d'ancre light	fla
10	3618	A	Alliance gravée 40/10è 1DT	fla	Créer PCP		01/12/2022	75
11	5135	C	Motif rose des vents PM 8 mm - reprise usinage	fla	Créer PCP		03/01/2022	1
12	6129	A	motif bracelet rose des vents 12 mm - reprise usinage	fla	Créer PCP Harmoniser cotes critiques selon motif Ø8 mm (prof 1,14 & 0,5)	Posage de contrôle	21/11/222	50
SUIVI

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
H2:H45	Other Type	DataBar		NO
B5	Expression	=#REF!="FAUX"	text	NO
B5	Expression	=#REF!="VRAI"	text	NO

02 - GESTIONNAIRE DES PCP - 01-02-23B.xlsm
	A	B	C	D	E	F	G
1	Colonne1	Colonne2	Colonne3	Sous-famille	Colonne4	Colonne5	igine de l'article
2	7485	B	SUPPT LAME FERMOIR BRACELET	SF	Fla	03/02/2023	En cours
3	7486	F	LAME FERMOIR BRACELET OG H1	SF	Fla	03/02/2023	En cours
4	7487	B	FAUX DE SECURITE PAVE FERMOIR BRACELET	SF	Fla	03/02/2023	x
5	7488	B	BOITIER INFERIEUR FERMOIR BRACELET	SF	Fla	03/02/2023
6	7489	B	BOITIER SUPERIEUR FERMOIR BRACELET	SF	Fla	03/02/2023
7	7491	B	SERTISSURE CENTRE 3 BRILLANT FERMOIR BRACELET	SF	Fla	03/02/2023
8	7492	A	SERTISSURE CENTRE TTO FERMOIR BRACELET	SF	Fla	03/02/2023	x
9	7494	B	SERTISSURE BOUT 3 BRILLANT FERMOIR BRACELET	SF	Fla	03/02/2023	x
10	7495	A	SERTISSURE BOUT TTO FERMOIR BRACELET	SF	Fla	03/02/2023	x
11	7496	A	GOUPILLE AXE DE FAUX FERMOIR BRACELET	SF	Fla	03/02/2023	x
12	7497	A	GOUPILLE CLIP DE FAUX FERMOIR BRACELET	SF	Fla	03/02/2023	x
13	7621	B	PIECE DE POUCE 3 BRILLANT FERMOIR BRACELET	SF	Fla	03/02/2023
14	7811	B	PIECE DE POUCE TOUT FERMOIR BRACELET	SF	Fla	03/02/2023
15	7843	B	FAUX DE SECURITE TTO FERMOIR BRACELET	SF	Fla	03/02/2023	x
16	10117	A	DESSUS SERTISSURE RONDE BRILLANT BRACELET OG_PROTO	SF	Fla	03/02/2023	x
17	10118	A	DESSUS SERTISSURE RONDE LIAISON ENTRE CNE BRILLANT BRACELET OG_PROTO	SF	Fla	03/02/2023	x
18	7811	B	PIECE DE POUCE TOUT FERMOIR BRACELET	SF	Fla	03/02/2023	x
POLKA

Cell Formulas
Range	Formula
A18	A18	=TEXTJOIN("",TRUE,IFERROR((MID(H18,ROW(INDIRECT("1:"&LEN(H18))),1)*1),""))
B18	B18	=RIGHT(H18,1)
F2:F18	F2	=TODAY()

 

[davesexcel]

Your sheets don't match your code.

 

[Flavien]

Your sheets don't match your code.

Thank you for your reply. Could you please guide me?

 

[davesexcel]

From what I can tell, you are looping through ws1 for "En cours" but "En cours", is in ws2

 

[Flavien]

From what I can tell, you are looping through ws1 for "En cours" but "En cours", is in ws2

Thank you for your advice!!
I replaced WS1 with WS2.... But the macro sticks the cut cells always on row 2. What am I doing wrong?

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("SUIVI")
Set ws2 = Worksheets("POLKA")
lig = 2

With ws2

For i = 2 To ws2.Range("A" & Rows.Count).End(xlUp).Row + 1
If Not .Rows(i).Hidden Then

If ws2.Cells(i, 7) = "En cours" Then


ws2.Cells(i, "A").Cut ws1.Cells(lig, "A")
ws2.Cells(i, "B").Cut ws1.Cells(lig, "B")
ws2.Cells(i, "C").Cut ws1.Cells(lig, "C")
ws2.Cells(i, "E").Cut ws1.Cells(lig, "D")
ws2.Cells(i, "F").Cut ws1.Cells(lig, "G")

lig = lig + 1


End If

End If

Next i

End With

Worksheets("POLKA").Columns("G").Replace what:="En cours", replacement:="x", lookat:=xlPart

MsgBox "Transfert terminé"

Application.ScreenUpdating = False
Application.DisplayAlerts = False


End Sub

 

[Flavien]

Finaly I have replaced:
"lig = 2" by "lig = ws1.Range("A" & Rows.Count).End(xlUp).Row + 1"

and deleted "lig = lig + 1"

Thank you again Davesexcel for your help!!!

 

[Flavien]

@davesexcel : Hello Daves,

I've one more question:
The macro turns all "In progress" cells into "x" even hidden lines. Do you have a solution?

 

[Flavien]

Hello @Peter_SSs , I allow myself to ask you because I did not find an answer to my question. Could you help me please ?
The macro turns all "In progress" cells into "x" even hidden lines. Do you have a solution?