Discussion :

[aitelhachmi]

Bonjour,

J'aimerais pouvoir appliquer un code VBA pour transférer des données de la feuille1 vers la feuille2 seulement si la colonne "État" contient la valeur "OK"

- Par exemple :

Les lignes 5 et 7 et 8 de mon tableau contiennent la Valeur "OK" dans la colonne "État" dans la feuille1

Résultat ==> Transférer de A5 à J5 et de L5 à Q5 (feuille1) >> vers >> (Feuille2) la dernière ligne vide de la colonne A à J et de M à R (Faire de même avec les lignes 7 et 8 de la feuille1)

Ci-joint un modèle sur quoi je veux appliquer le code VBA

Je vous remercie d'avance.

[BENNASR]

salam aitelhachmi, bonjour la forum

filtrer les données avec critère la colonne concernée; Envoyer les données visible après le filtre et puis annuler le filtre

à tester :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Option Explicit
Sub test()
Dim F1 As Worksheet
Dim F2 As Worksheet
Dim I As Long
Dim J As Long
 Application.ScreenUpdating = False
 Set F1 = Sheets("Feuil1")
 Set F2 = Sheets("Feuil2")
 J = F2.Cells(Rows.Count, 1).End(xlUp).Row
 If J > 3 Then F2.Range("A5:R" & J).ClearContents
 
I = F1.Cells(Rows.Count, 5).End(xlUp).Row
 
F1.Range("A3:Q" & I).AutoFilter Field:=11, Criteria1:="OK"
 
F1.Range("A4:Q" & I).SpecialCells(xlCellTypeVisible).Copy Destination:=F2.Range("A4")
 
If Not F1.AutoFilter Is Nothing Then
      If F1.FilterMode Then F1.ShowAllData
      F1.AutoFilter.Range.AutoFilter
    End If
 Application.ScreenUpdating = True
 F2.Select
End Sub

Bonne Continuation

[aitelhachmi]

Bonjour BENNASR, Merci de votre réponse rapide,
Je crois que je me suis mal exprimé, je vais essayer de détailler le mieux possible.

Le fichier Excel final sera partagé avec 2 personnes en ligne (Co-Edition), l'une s'occupe de la feuille1 (Pour traiter avec le client sa commande par téléphone) et l'autre s'occupe de la feuille2 (Préparation et expédition de la commande déjà traitée dans la feuille1).

L'idée est de transférer les commandes traitées avec le client par téléphone de la feuille 1 à la feuille 2 pour pouvoir l'expédier, une fois la commande est confirmée on choisi "OK" dans la colonne "État" et puis depuis la feuille2 on exécute le code VBA pour appliquer le transfert, une fois la commande est transférée le statut "OK" doit changer automatiquement et devenir "Transféré" (On parle là juste de la feuille1)

Le soucis ici est dans la feuille2 il y a une nouvelle colonne nommée "Service de livraison" entre "État" et "Autres produits 1" ce qui nous oblige de décaler les valeurs transférées d'une colonne de plus en commençant par la colonne L.

Pour préciser, le transfert doit se faire de cette façon en respectant les conditions décrit ci-dessus :

- Feuil1: Srce (Colonne A) ==> Feuil2: Srce (Colonne A)
- Feuil1: REF (Colonne B) ==> Feuil2: REF (Colonne B)
- Feuil1: Nom complet (Colonne C) ==> Feuil2: Nom complet (Colonne C)
- Feuil1: Adresse (Colonne D) ==> Feuil2: Adresse (Colonne D)
- Feuil1: Ville (Colonne E) ==> Feuil2: Ville (Colonne E)
- Feuil1: Téléphone (Colonne F) ==> Feuil2: Téléphone (Colonne F)
- Feuil1: Description (Colonne G) ==> Feuil2: Description (Colonne G)
- Feuil1: Date (Colonne H) ==> Feuil2: Date (Colonne H)
- Feuil1: Prix (Colonne I) ==> Feuil2: Description (Colonne I)
- Feuil1: Qté (Colonne J) ==> Feuil2: Description (Colonne J)
- Feuil1: État (Colonne K) ==> NE PAS TRANSFÉRER (A LAISSER VIDE dans la feuil2)
- Feuil2: Service de livraison (Colonne L) ==> Nouvelle colonne crée uniquement dans la feuil2 et DOIT RESTER VIDE
LE RESTE DES COLONNES SERONT DECALEES PAR UNE COLONNE Comme suit :
- Feuil1: Autres Produits 1 (Colonne L) ==> Feuil2: Autres Produits 1 (Colonne M)
- Feuil1: Qté AP1 (Colonne M) ==> Feuil2: Qté AP1 (Colonne N)
- Feuil1: Autres Produits 2 (Colonne N) ==> Feuil2: Autres Produits 2 (Colonne O)
- Feuil1: Qté AP2 (Colonne O) ==> Feuil2: Qté AP2 (Colonne P)
- Feuil1: Autres Produits 3 (Colonne P) ==> Feuil2: Autres Produits 3 (Colonne Q)
- Feuil1: Qté AP3 (Colonne Q) ==> Feuil2: Qté AP3 (Colonne R)

N.B 1 : Je dois absolument garder les commandes transférées en permanence dans la feuil2
N.B 2 : J'aimerais savoir si ça se trouve une solution pour alléger la taille de mon fichier qui est déjà lourd, et je suis ouvert à toute autre suggestion vu mon niveau nul en EXCEL et encore pire en VBA

Je vous remercie beaucoup d'avoir consacré votre temps pour mon problème.

[BENNASR]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Option Explicit
Sub test()
Dim F1 As Worksheet
Dim F2 As Worksheet
Dim I As Long
Dim J As Long
 Application.ScreenUpdating = False
 Set F1 = Sheets("Feuil1")
 Set F2 = Sheets("Feuil2")
 J = F2.Cells(Rows.Count, 1).End(xlUp).Row
 If J > 3 Then F2.Range("A5:R" & J).ClearContents
 
I = F1.Cells(Rows.Count, 5).End(xlUp).Row
 
F1.Range("A3:Q" & I).AutoFilter Field:=11, Criteria1:="OK"
 
F1.Range("A4:J" & I).SpecialCells(xlCellTypeVisible).Copy Destination:=F2.Range("A4")
F1.Range("L4:Q" & I).SpecialCells(xlCellTypeVisible).Copy Destination:=F2.Range("M4")
 
If Not F1.AutoFilter Is Nothing Then
      If F1.FilterMode Then F1.ShowAllData
      F1.AutoFilter.Range.AutoFilter
    End If
 Application.ScreenUpdating = True
 F2.Select
End Sub

[aitelhachmi]

C'est parfait, Merci beaucoup pour votre aide précieuse, Il reste la partie du changement du statut "OK" en "Transféré", je vais la modifier moi même, Je vous remercie une nouvelle fois et bonne journée à vous.

[BENNASR]

mon ami ...quelques modifications à tester pour ne pas avoir de prob si il n' y a pas de données à importer
à tester

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Option Explicit
Sub test()
Dim F1 As Worksheet
Dim F2 As Worksheet
Dim I As Long
Dim J As Long
 Application.ScreenUpdating = False
 Set F1 = Sheets("Feuil1")
 Set F2 = Sheets("Feuil2")
 J = F2.Cells(Rows.Count, 1).End(xlUp).Row + 1
 I = F1.Cells(Rows.Count, 5).End(xlUp).Row
F1.Range("A3:Q" & I).AutoFilter Field:=11, Criteria1:="OK"
Dim l As Long
l = F1.Cells.Find("*", [A1], , , 1, 2).Row
If l = 3 Then
MsgBox "Aucune nouvelle donnée à importer YAL KHOU !!!"
Else
F1.Range("A4:J" & I).SpecialCells(xlCellTypeVisible).Copy Destination:=F2.Range("A" & J)
F1.Range("L4:Q" & I).SpecialCells(xlCellTypeVisible).Copy Destination:=F2.Range("M" & J)
F1.Range("K4:K" & I).SpecialCells(xlCellTypeVisible) = "Transféré"
End If
If Not F1.AutoFilter Is Nothing Then
      If F1.FilterMode Then F1.ShowAllData
      F1.AutoFilter.Range.AutoFilter
    End If
 Application.ScreenUpdating = True
 F2.Select
End Sub