VBA ne pas copier si ligne marqué
Bonjour,
Voici mon probleme, j'ai une macro "CopierDansSAPHeader"que je fais tourner avec un bouton,
Je reprends des données de la feuille SCHEDULE, ligne par ligne, que je viens recopier dans un nouvelle feuille SAP HEADER.
J'aimerais que lorsque ma macro a fini de tourner, un X soi inscrit dans chaque cellule de la colonne IW32.
Au final j'aimerais modifier la macro "copierDans SAPHeader" pour qu'elle fonctionne que sur les lignes qui n'ont pas de X dans la colonne IW32.
En espérant avoir été clair, merci de votre aide
Bonjour Steve, bonjour le forum,
Peut-être comme ça :
Sub CollerDansSapHEADER()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I&, K& 'déclare les variables I et K (incrément)
Set OS = Sheets("SCHEDULE") 'définit l'onglet source OS
Set OD = Sheets("SAP HEADER") 'définit l'onglet destination OD
TV = OS.Range("A1").CurrentRegion 'définit la tableau des valeurs TV
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
K = 1 'initialise la variable K
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
If Not D.exists(TV(I, 2) & TV(I, 17)) Then 'condition 1 : si la donnée combinée TV(I,2) et TV(I,17) n'existe pas dans le dictionnaire
If TV(I, 18) <> "X" Then 'condition 2 : si la donnée ligne I colonne 18 de TV est différente de "X"
D(TV(I, 2) & TV(I, 17)) = "" 'alimente le dictionnaire avec la donnée combinée TV(I,2) et tv(I,17)
OS.Cells(I, "R").Value = "X" 'écrit "X" dans la cellule ligne I colonne R de l'onglet source OS
ReDim Preserve TL(1 To 4, 1 To K + 1) 'redimensionne le tableau des lignes TL (4 lignes, K colonnes)
TL(1, K) = TV(I, 2) 'récupère dans la ligne 1 de TL la donnée en colonne 2 de TV
TL(3, K) = TV(I, 17) 'récupère dans la ligne 3 de TL la donnée en colonne 17 de TV
TL(4, K) = TV(I, 17) 'récupère dans la ligne 4 de TL la donnée en colonne 17 de TV
K = K + 1 'incrémente K
End If 'fin de la condition 2
End If 'fin de la condition 1
Next I 'prochaine ligne de la boucle
OD.Range("A1").CurrentRegion.Offset(1, 0).ClearContents 'efface les anciennes valeurs de l'onglet destination (sauf la première ligne)
OD.Range("A2").Resize(K - 1, 4) = Application.Transpose(TL) 'renvoie dans A2 redimensionnée de l'onglet destination, le tableau TL transposé
End SubBonjour ThauTheme,
Merci de ton aide, cela ne correpond pas tout à fait à ce que j'ai besoin, mais je pense qu'on en ai pas loin. En faite, dés que la macro tourne il faut marquer toutes lignes car je les considere traitées
Le but est que si j'ajoute des lignes manuellement, je ne colle que les lignes qui ne sont pas marquées.
Bonjour Steve, bonjour le forum,
Il suffit de déplacer une ligne de code. Des fois je me demande à quoi ça sert que je commente mes codes ?!...
Sub CollerDansSapHEADER()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I&, K& 'déclare les variables I et K (incrément)
Set OS = Sheets("SCHEDULE") 'définit l'onglet source OS
Set OD = Sheets("SAP HEADER") 'définit l'onglet destination OD
TV = OS.Range("A1").CurrentRegion 'définit la tableau des valeurs TV
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
K = 1 'initialise la variable K
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
OS.Cells(I, "R").Value = "X" 'écrit "X" dans la cellule ligne I colonne R de l'onglet source OS
If Not D.exists(TV(I, 2) & TV(I, 17)) Then 'condition 1 : si la donnée combinée TV(I,2) et TV(I,17) n'existe pas dans le dictionnaire
If TV(I, 18) <> "X" Then 'condition 2 : si la donnée ligne I colonne 18 de TV est différente de "X"
D(TV(I, 2) & TV(I, 17)) = "" 'alimente le dictionnaire avec la donnée combinée TV(I,2) et tv(I,17)
ReDim Preserve TL(1 To 4, 1 To K + 1) 'redimensionne le tableau des lignes TL (4 lignes, K colonnes)
TL(1, K) = TV(I, 2) 'récupère dans la ligne 1 de TL la donnée en colonne 2 de TV
TL(3, K) = TV(I, 17) 'récupère dans la ligne 3 de TL la donnée en colonne 17 de TV
TL(4, K) = TV(I, 17) 'récupère dans la ligne 4 de TL la donnée en colonne 17 de TV
K = K + 1 'incrémente K
End If 'fin de la condition 2
End If 'fin de la condition 1
Next I 'prochaine ligne de la boucle
OD.Range("A1").CurrentRegion.Offset(1, 0).ClearContents 'efface les anciennes valeurs de l'onglet destination (sauf la première ligne)
OD.Range("A2").Resize(K - 1, 4) = Application.Transpose(TL) 'renvoie dans A2 redimensionnée de l'onglet destination, le tableau TL transposé
End SubHello Thau Théme,
Je regarde merci. Pour répondre à ta question, ca me sert à comrendre mais je ne percute pas assez vite pour trouver la solution.
J'étais entrain de décortiquer ta 1ere réponse afin de comprendre comment je pouvais réadapter . Mais tu as répondu avant que je trouve!
Ne change rien à ta façon de faire et continue à commenter car cela va me permettre de decortiquer ton code et peut être, qui sait être autonome!
Merci
Bonjour,
J'ai une erreure si je fais tourner la macro alors que toutes les cases sont cochées.
Je voudrais donc inserer une condition pour ne pas lancer la macro si toutes les lignes sont cochées.
Bonjour Thautheme,
Au final j'aurais aimé que la condition créé precedement soit également valable pour le remplissage de l'onglet SAP DETAIL.
Depuis hier soir je tatonne mais cela n'abouti pas. Je vois bein ou sont les conditions mais je ne sais pas comment integrer mon bout de code dans cette condition!
En même temps c'est le bazard dans mes bouts de code!
Re,
remplace la ligne :
OD.Range("A2").Resize(K - 1, 4) = Application.Transpose(TL) 'renvoie dans A2 redimensionnée de l'onglet destination, le tableau TL transposépar :
If K > 1 Then OD.Range("A2").Resize(K - 1, 4) = Application.Transpose(TL) 'renvoie dans A2 redimensionnée de l'onglet destination, le tableau TL transposéAprès ça plante sur le tri mais au départ ce n'était pas cette macro ?!...
Bonjour ThauTheme,
Effectivement ce n'était pas la même macro. Je voudrais combiner la macro se trouvant dans module 1 avec la macro se trouvant dans module 3 .
Cela signifie que j'aimerais utiliser la meme condition que pour remplir l'onglet SAP HEADER: on écrit des lignes dans l'onglet SAP DETAIL que si aucune ligne est cochée. dans l'onglet schedule
Bien entendu l'Onglet SAP hedeer et SAP detail se remplissent en meme temps..
Je viens de passer quelques heures sur le sujet, j'arrive bien à ne pas écrire une ligne si celle ci est marqué mais je n'arrive pas à marquer la ligne au bon momment, elle est toujours marquée avant la scrutation et donc la ligne est toujours considérée marquée.