Copier des cellules d'un onglet A vers un B avec tri
Bonjour
Je suis bloqué depuis pas mal de temps sur le sujet, j'ai essayé de le faire tout seul mais n'ayant jamais fait de Excel n'est de VBA je n'avance pas ! un coup de main ne serait pas de refus !!
Le but est de copier des cellule ou des lignes entières de l'Onglet appeler V6.x vers un Onglet que je crée dans la foulé qui s’appellera env.conf si ces lignes sont remplient dans l'onglet V6.x
Mon code ressemble à ça pour l'instant, je copie une seule ligne "A2:D2" je n'arrive pas à prendre plusieurs linges
quand cette ligne est mise dans l'onglet env.conf je modifie les cellule
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sh, LastRow As Long, addr As String
If Target = "" Or Target.Column <> 3 Then Exit Sub
Set sh = Sheets("env.conf" & Target)
LastRow = sh.Cells(Rows.Count, 1).End(xlUp).Row
addr = Range(Cells(Target.Row, 1), Cells(Target.Row, Columns.Count - 1)).Address
ActiveSheet.Range(addr).Copy sh.Range("A" & LastRow + 1)
'Sheets.Add.Name = "conf.env" 'ajoute une Feuille devant la Feuille active et la nomme "NouvelleFeuille"
'Creation de l'onglet env.conf
Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = "env.conf"
'Deplacement des cellules de la Fauil1 à la Feuil2
Worksheets("env.conf").Range("A1:D1").Value = Worksheets("V6.x").Range("A2:D2").Value
'End With
'Activation de la feuille 1
With Sheets("env.conf")
'Workbooks("env.conf").Activate
'Range("A2:D2") = Range("A1:D1")
'ENV
Range("A1").Value = "ENV;"
'Tapez le numero de port
Range("F1") = Range("C1")
'Remplacer la cellule C par B
Range("D1") = Range("B1")
'Taper le nom de lenvironnement en dessous dans la case entre ""
Range("B1").Value = " ;"
'XDUAS_COMPANY
Range("C1").Value = "XDUAS_COMPANY;"
'XDUAS_PORT
Range("E1").Value = "XDUAS_PORT;"
End With
End Sub
Bonjour,
En fait, j'ai l'impression que votre code a été retouché à de nombreuses reprises, ce qui fait qu'on ne sait plus trop où se situer. Je pense qu'il faut scinder les objectifs. Arriver à agir sur une ligne, puis le faire sur plusieurs lignes (si c'est bien l'objectif) en cadrant les conditions, et enfin, éventuellement, appeler la macro via un évènement.
Pour l'instant, est-ce que ce code (à mettre dans un module normal) fait une partie de ce que vous désirez ?
Sub EnvoiConf()
Dim shV6 as worksheet, shEnv as worksheet
Set shV6 = Worksheets("V6.x")
Set shEnv = Sheets.Add(After:=Worksheets(Worksheets.Count)) 'Creation de l'onglet env.conf
With shEnv
.Name = "env.conf"
.Range("A1").Value = "ENV;"
.Range("B1").Value = " ;"
.Range("C1").Value = "XDUAS_COMPANY;"
.Range("D1").value = shV6.Range("B2").value
.Range("E1").Value = "XDUAS_PORT;"
.Range("F1").value = shV6.Range("C2").value
End With
End Sub
Cdlt,
Merci pour ta réponse, l’écriture est très limpide
Il me reste plus qu'à trouver l’événement qui me déclencherait la macro au moment ou je remplie le fichier source
Il faudrait que j'arrive à copier uniquement les lignes ajoutées, comme avec la condition ci-dessous :
Je l'ai testé ça ne fait rien ! c'est un bout de code que j'ai récupéré sur ce forum
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sh, LastRow As Long, addr As String
If Target = "" Or Target.Column <> 3 Then Exit Sub
Set sh = Sheets("env.conf" & Target)
LastRow = sh.Cells(Rows.Count, 1).End(xlUp).Row
addr = Range(Cells(Target.Row, 1), Cells(Target.Row, Columns.Count - 1)).Address
ActiveSheet.Range(addr).Copy sh.Range("A" & LastRow + 1)
Cdt,
Pour l'instant, le code est insuffisant puisqu'il reprend uniquement 2 éléments de la ligne 2 de V6 pour les mettre sur la ligne 1 de env.conf.
Pour la condition, il faut déjà bien savoir ce que c'est : quand quelle cellule est modifiée, on exécute ? On exécute sur la ligne en cours ?
le mieux serait de l'exécuter sur la ligne en cours, mais un problème se pose ! si j'ai 3 lignes il va copier ligne après ligne dans le conf et là je pense que ce n'est pas possible parce qu'il recrée le env.conf à chaque ajout de ligne
Voici un premier essai avec une procédure dynamique exécutée sur la ligne en cours, sauf en cas de modifications multiples et de cellules vides, et avec une demande de confirmation. Je suis pas certain du résultat car les macros évènementielles sont délicates à manipuler.
'DANS UN MODULE NORMAL
Sub EnvoiConf(Cible as range)
Dim shV6 as worksheet, shEnv as worksheet
Dim Lcible as long, NvL as long
Set shV6 = Worksheets("V6.x")
Lcible = Cible.Row 'ligne en cours
If Worksheets(Worksheets.Count).Name = "env.conf" then si existe deja
Set shEnv = Sheets("env.conf") 'shEnv = env.conf
else
Set shEnv = Sheets.Add(After:=Worksheets(Worksheets.Count)) 'sinon, Creation de l'onglet env.conf
shEnv.Name = "env.conf" 'on renomme
end if
With shEnv
NvL = .cells(rows.count, 1).end(xlup).row 'nouvelle ligne (dernière + 1)
if NvL > 1 then NvL = NvL + 1
.cells(NvL, 1).Value = "ENV;"
.cells(NvL, 2).Value = " ;"
.cells(NvL, 3).Value = "XDUAS_COMPANY;"
.cells(NvL, 4).value = shV6.Cells(Lcible, 2).value
.cells(NvL, 5).Value = "XDUAS_PORT;"
.cells(NvL, 6).value = shV6.Cells(Lcible, 3).value
End With
End Sub
'DANS LE MODULE DE LA FEUILLE V6
Private Sub Worksheet_Change(ByVal Target As Range)
If not intersect(Target, range("A:F")) is nothing and not target.count > 1 then
If not application.countblank(range("A" & target.row & ":F" & target.row)) > 0 then
If msgbox("Voulez-vous envoyer les données ?", vbyesno, "demande de confirmation") = vbyes then
Call EnvoiConf(Target)
end if
end if
end if
End sub
Bonne soirée,
De meme et merci
ça n'a pas l'air de se déclencher
Désolé je n'arrive pas l’exécuter, j'ai fait ce que vous avez demandé
le 1er code en Module et le 2eme sur la feuil V6.x, mais quand je rempli le fichier il ne se passe rien !
Cdt,
Je vient de m’apercevoir qu'il y avait une erreur dans la procédure d’événement
Le D au lieu du F, par contre on ne peut pas rajouter plusieurs lignes dans le env.conf, il est effacé à chaque écriture de ligne dans le xls
Existe t-il un moyen pour mettre toutes les lignes rajoutés et le conditionné la marco sur la fermeture du fichier par exemple, mais un problème se pose ! comment il saura ou trouvera t-il uniquement les lignes ajoutés à chaque fois ? mettre un conteur à chaque fermeture ? !
Et aussi comment mettre un ";" à la fin de la Lcible 2 et 3 ?
.Cells(NvL, 4).Value = shV6.Cells(Lcible, 2).Value
.Cells(NvL, 6).Value = shV6.Cells(Lcible, 3).Value
Merci
If not intersect(Target, range("A:F")) is nothing and not target.count > 1 then
If not application.countblank(range("A" & target.row & ":F" & target.row)) > 0 then
Bonsoir spoutnik,
Je suis désolé, je n'ai pas beaucoup de temps pour regarder en ce moment.
Déjà, j'ai édité mon code car j'y ai oublié une ligne de taille expliquant l'effacement du contenu dans env.conf. Ce code devrait mieux fonctionner (avec les ";") :
'DANS UN MODULE NORMAL
Sub EnvoiConf(Cible as range)
Dim shV6 as worksheet, shEnv as worksheet
Dim Lcible as long, NvL as long
Set shV6 = Worksheets("V6.x")
Lcible = Cible.Row 'ligne en cours
If Worksheets(Worksheets.Count).Name = "env.conf" then si existe deja
Set shEnv = Sheets("env.conf") 'shEnv = env.conf
else
Set shEnv = Sheets.Add(After:=Worksheets(Worksheets.Count)) 'sinon, Creation de l'onglet env.conf
shEnv.Name = "env.conf" 'on renomme
end if
With shEnv
NvL = .cells(rows.count, 1).end(xlup).row 'nouvelle ligne (dernière + 1)
if NvL > 1 then NvL = NvL + 1 'ligne oubliée : si ligne 1 vide, commence à ligne 1, sinon continue à ligne n+1
.cells(NvL, 1).Value = "ENV;"
.cells(NvL, 2).Value = " ;"
.cells(NvL, 3).Value = "XDUAS_COMPANY;"
.cells(NvL, 4).value = shV6.Cells(Lcible, 2).value & ";" ' !!! l'opérateur & permet de concaténer des chaines de caractères
.cells(NvL, 5).Value = "XDUAS_PORT;"
.cells(NvL, 6).value = shV6.Cells(Lcible, 3).value & ";"
End With
End Sub
Je vais regarder ton fichier quand j'aurai le temps, ce sera plus clair pour les évènements. Sinon, à la fermeture c'est possible. Mais la meilleure idée serait de prendre toutes les lignes de v6, les envoyer sur env.conf et les supprimer sur v6, à chaque fermeture par exemple. Comme ça, pas besoin de compteur. Sinon, l'option compteur devrait se faire facilement à l'ouverture.
Mais en fait, le réel problème réside dans les cas de doublons. Est-ce possible qu'il y en ait ? Comment les gérer ?
Si il ne devrait pas y avoir de doublons de deux lignes identiques, car le fichier env.conf ne peut pas contenir deux CND001 et deux numéro de port identiques
Encore un autre truc, peut-on spliter un cellule, genre pour la colonne C on prend que la premier nombre 32000 à 32040
Je viens de tester ton dernier code, le fichier env.conf est toujours effacé à chaque génération d'une nouvelle ligne
Ce n'est pas grave si tu n'as pas beaucoup de temps, tu m'as énormément aidé et je t'en remercie
Cdt,
Un collègue m'a aidé pour rajouter une 2eme ligne dans le env.conf sans que celui-ci est effacé à chaque fois
Par contre peut spliter la colonne F dans le fichier destinataire pour en garder qu'une valeur 34500 à 33600 ?
Merci d'avance pour ton aide
J'ai besoin de rajouter des lignes fixes à la fin de ma feuille B une fois que le tri a été fait
Les lignes que je voudrais rajouter sont les suivantes :
UVMS;ENV1;;;HOST1;12345
UVMS;ENV2;;;HOST2;125689
UVMS;ENV3;;;HOST3;2568952
UVMS;ENV4;;;HOST4;545664
UVMS;ENV5;;;HOST5;798512514
UVMS;ENV6;;;HOST6;254456768325325456748787
UVMS;ENV7;;;HOST7;45875425254
UVMS;ENV8;;;HOST8;000225455
UVMS;ENV9;;;HOST9;99885522
UVMS;ENV10;;;HOST10;98857584542211
UVMS;ENV11;;;HOST11;1564654878758114
Cdt,
Le code il fait ça
Sub EnvoiConf(Cible As Range)
Dim shV6 As Worksheet, shEnv As Worksheet
Dim Lcible As Long, NvL As Long
Set shV6 = Worksheets("V6.x")
Set shVP = Sheets("PARAM")
Lcible = Cible.Row 'ligne en cours
If Worksheets(Worksheets.Count).Name = "env.conf" Then
Set shEnv = Sheets("env.conf") 'shEnv = env.conf
Else
Set shEnv = Sheets.Add(After:=Worksheets(Worksheets.Count)) 'sinon, Creation de l'onglet env.conf
shEnv.Name = "env.conf" 'on renomme
End If
With shEnv
NvL = .Cells(Rows.Count, 1).End(xlUp).Row 'nouvelle ligne (dernière + 1)
' teste si decalage de ligne necessaire :
' -si onglet vierge alors pas de decalage
' -sinon decalage necessaire
If (NvL = 1 And .Cells(NvL, 1).Value <> "") Or NvL > 1 Then
NvL = NvL + 1
End If
.Cells(NvL, 1).Value = "ENV;"
.Cells(NvL, 2).Value = " ;"
.Cells(NvL, 3).Value = "XDUAS_COMPANY;"
.Cells(NvL, 4).Value = shV6.Cells(Lcible, 2).Value & ";" ' !!! l'opérateur & permet de concaténer des chaines de caractères
.Cells(NvL, 5).Value = "XDUAS_PORT;"
.Cells(NvL, 6).Value = Left(shV6.Cells(Lcible, 3), 5)
.Cells(NvL).Value = shVP.Cells(Lcible) ' => Cette commande est mauvaise, ce que j'aimerais faire c'est de copier à la fin du traitement 10 lignes entières apres l 'instruction suivante Cells(NvL, 6).Value = Left(shV6.Cells(Lcible, 3), 5)
End With
La commande que je veux intégrer dans l'instruction .Cells(NvL).Value = shVP.Cells(Lcible) est la suivante :
' Worksheets("PARAM").Range("A1:E1").Copy Worksheets("env.conf").Range("newligne + 1")
J'ai fait ça qui fonctionne, mais pas comme je veux
Sub EnvoiConf(Cible As Range)
Dim shV6 As Worksheet, shEnv As Worksheet
Dim Lcible As Long, NvL As Long
Set shV6 = Worksheets("V6.x")
Lcible = Cible.Row 'ligne en cours
If Worksheets(Worksheets.Count).Name = "env.conf" Then
Set shEnv = Sheets("env.conf") 'shEnv = env.conf
Else
Set shEnv = Sheets.Add(After:=Worksheets(Worksheets.Count)) 'sinon, Creation de l'onglet env.conf
shEnv.Name = "env.conf" 'on renomme
End If
With shEnv
NvL = .Cells(Rows.Count, 1).End(xlUp).Row 'nouvelle ligne (dernière + 1)
' teste si decalage de ligne necessaire :
' -si onglet vierge alors pas de decalage
' -sinon decalage necessaire
If (NvL = 1 And .Cells(NvL, 1).Value <> "") Or NvL > 1 Then
NvL = NvL + 1
End If
.Cells(NvL, 1).Value = "ENV;"
.Cells(NvL, 2).Value = " ;"
.Cells(NvL, 3).Value = "XDUAS_COMPANY;"
.Cells(NvL, 4).Value = shV6.Cells(Lcible, 2).Value & ";" ' !!! l'opérateur & permet de concaténer des chaines de caractères
.Cells(NvL, 5).Value = "XDUAS_PORT;"
.Cells(NvL, 6).Value = Left(shV6.Cells(Lcible, 3), 5)
End With
'Set shVP = Sheets("PARAM")
With shEnv
NvL = .Cells(Rows.Count, 1).End(xlUp).Row 'nouvelle ligne (dernière + 1)
If (NvL = 1 And .Cells(NvL, 1).Value <> "") Or NvL > 1 Then
NvL = NvL + 1
End If
Worksheets("PARAM").Range("A1:E1").Copy Worksheets("env.conf").Range("A" & (NvL))
Worksheets("PARAM").Range("A2:E2").Copy Worksheets("env.conf").Range("A" & (NvL) + 1)
Worksheets("PARAM").Range("A3:E3").Copy Worksheets("env.conf").Range("A" & (NvL) + 2)
Worksheets("PARAM").Range("A4:E4").Copy Worksheets("env.conf").Range("A" & (NvL) + 3)
Worksheets("PARAM").Range("A5:E5").Copy Worksheets("env.conf").Range("A" & (NvL) + 4)
Worksheets("PARAM").Range("A6:E6").Copy Worksheets("env.conf").Range("A" & (NvL) + 5)
Worksheets("PARAM").Range("A7:E7").Copy Worksheets("env.conf").Range("A" & (NvL) + 6)
Worksheets("PARAM").Range("A8:E8").Copy Worksheets("env.conf").Range("A" & (NvL) + 7)
Worksheets("PARAM").Range("A9:E9").Copy Worksheets("env.conf").Range("A" & (NvL) + 8)
Worksheets("PARAM").Range("A10:E10").Copy Worksheets("env.conf").Range("A" & (NvL) + 9)
End With
End Sub
Je voudrai que ces lignes soient rajoutés à la fin et cela meme si j'ai plusieurs lignes à saisir dans le V6.x
Actuellement il me les rajoute à chaque ajout de ligne dans V6.x
Worksheets("PARAM").Range("A1:E1").Copy Worksheets("env.conf").Range("A" & (NvL))
Worksheets("PARAM").Range("A2:E2").Copy Worksheets("env.conf").Range("A" & (NvL) + 1)
Worksheets("PARAM").Range("A3:E3").Copy Worksheets("env.conf").Range("A" & (NvL) + 2)
Worksheets("PARAM").Range("A4:E4").Copy Worksheets("env.conf").Range("A" & (NvL) + 3)
Worksheets("PARAM").Range("A5:E5").Copy Worksheets("env.conf").Range("A" & (NvL) + 4)
Worksheets("PARAM").Range("A6:E6").Copy Worksheets("env.conf").Range("A" & (NvL) + 5)
Worksheets("PARAM").Range("A7:E7").Copy Worksheets("env.conf").Range("A" & (NvL) + 6)
Worksheets("PARAM").Range("A8:E8").Copy Worksheets("env.conf").Range("A" & (NvL) + 7)
Worksheets("PARAM").Range("A9:E9").Copy Worksheets("env.conf").Range("A" & (NvL) + 8)
Worksheets("PARAM").Range("A10:E10").Copy Worksheets("env.conf").Range("A" & (NvL) + 9)
Cdt
Salut spoutnik,
Quand j'aurai un peu de temps, je te répondrai correctement.
En attendant, pourrais-tu insérer ton code via le logo avec les balises </> afin qu'il soit plus lisible.
A bientôt,
Sub EnvoiConf(Cible As Range)
Dim shV6 As Worksheet, shEnv As Worksheet
Dim Lcible As Long, NvL As Long
Set shV6 = Worksheets("V6.x")
Lcible = Cible.Row 'ligne en cours
If Worksheets(Worksheets.Count).Name = "env.conf" Then
Set shEnv = Sheets("env.conf") 'shEnv = env.conf
Else
Set shEnv = Sheets.Add(After:=Worksheets(Worksheets.Count)) 'sinon, Creation de l'onglet env.conf
shEnv.Name = "env.conf" 'on renomme
End If
With shEnv
NvL = .Cells(Rows.Count, 1).End(xlUp).Row 'nouvelle ligne (dernière + 1)
' teste si decalage de ligne necessaire :
' -si onglet vierge alors pas de decalage
' -sinon decalage necessaire
If (NvL = 1 And .Cells(NvL, 1).Value <> "") Or NvL > 1 Then
NvL = NvL + 1
End If
.Cells(NvL, 1).Value = "ENV;"
.Cells(NvL, 2).Value = " ;"
.Cells(NvL, 3).Value = "XDUAS_COMPANY;"
.Cells(NvL, 4).Value = shV6.Cells(Lcible, 2).Value & ";" ' !!! l'opérateur & permet de concaténer des chaines de caractères
.Cells(NvL, 5).Value = "XDUAS_PORT;"
.Cells(NvL, 6).Value = Left(shV6.Cells(Lcible, 3), 5)
End With
'Set shVP = Sheets("PARAM")
With shEnv
NvL = .Cells(Rows.Count, 1).End(xlUp).Row 'nouvelle ligne (dernière + 1)
If (NvL = 1 And .Cells(NvL, 1).Value <> "") Or NvL > 1 Then
NvL = NvL + 1
End If
Worksheets("PARAM").Range("A1:E1").Copy Worksheets("env.conf").Range("A" & (NvL))
Worksheets("PARAM").Range("A2:E2").Copy Worksheets("env.conf").Range("A" & (NvL) + 1)
Worksheets("PARAM").Range("A3:E3").Copy Worksheets("env.conf").Range("A" & (NvL) + 2)
Worksheets("PARAM").Range("A4:E4").Copy Worksheets("env.conf").Range("A" & (NvL) + 3)
Worksheets("PARAM").Range("A5:E5").Copy Worksheets("env.conf").Range("A" & (NvL) + 4)
Worksheets("PARAM").Range("A6:E6").Copy Worksheets("env.conf").Range("A" & (NvL) + 5)
Worksheets("PARAM").Range("A7:E7").Copy Worksheets("env.conf").Range("A" & (NvL) + 6)
Worksheets("PARAM").Range("A8:E8").Copy Worksheets("env.conf").Range("A" & (NvL) + 7)
Worksheets("PARAM").Range("A9:E9").Copy Worksheets("env.conf").Range("A" & (NvL) + 8)
Worksheets("PARAM").Range("A10:E10").Copy Worksheets("env.conf").Range("A" & (NvL) + 9)
End With
End Sub
Re spoutnik,
Voici ton code légèrement modifié (ce n'était qu'une question de syntaxe) qui devrait marcher.
Une fois que ta macro sera bien, il faudra définir correctement l'évènement qui permet de l'exécuter.
Sub EnvoiConf(Cible As Range)
Dim shV6 As Worksheet, shEnv As Worksheet, shVP as worksheet
Dim Lcible As Long, NvL As Long
Set shV6 = Worksheets("V6.x")
Set shVP = Sheets("PARAM")
Lcible = Cible.Row 'ligne en cours
If Worksheets(Worksheets.Count).Name = "env.conf" Then 'si env.conf existe
Set shEnv = Sheets("env.conf") 'shEnv = env.conf 'affectation de shEnv
Else
Set shEnv = Sheets.Add(After:=Worksheets(Worksheets.Count)) 'sinon, Creation d'un nouvel onglet
shEnv.Name = "env.conf" 'on le renomme env.conf
End If
With shEnv 'sur env.conf
NvL = .Cells(Rows.Count, 1).End(xlUp).Row 'NvL = dernière ligne
If (NvL = 1 And .Cells(NvL, 1).Value <> "") Or NvL > 1 Then NvL = NvL + 1 'si onglet non vierge, décalage : NvL = nvlle ligne
.Cells(NvL, 1).Value = "ENV;"
.Cells(NvL, 2).Value = " ;"
.Cells(NvL, 3).Value = "XDUAS_COMPANY;"
.Cells(NvL, 4).Value = shV6.Cells(Lcible, 2).Value & ";" ' !!! l'opérateur & permet de concaténer des chaines de caractères
.Cells(NvL, 5).Value = "XDUAS_PORT;"
.Cells(NvL, 6).Value = Left(shV6.Cells(Lcible, 3), 5)
'la nvlle commande souhaitée
NvL = NvL + 1 'recalcul nouvelle ligne = dernière + 1 (on considère env.conf non vierge maintenant)
shVP.Range("A1:E10").Copy .Range("A" & NvL) 'copie A1:E10 de PARAM vers A:E de env.conf à partir nvlle ligne
End With
End Sub
Bonne soirée,
Merci pour la modification
En fait il y a une autre problème, je ne souhaite pas que cette ligne soit ajoutée à chaque fois
shVP.Range("A1:E10").Copy .Range("A" & NvL) 'copie A1:E10 de PARAM vers A:E d env.conf à partir nvlle ligne
Le but serait quelle se mette à la fin du env.conf mais qu'un fois, on est d'accord que actuellement les dix lignes sont rajoutés à chaque action opéré dans le V6.x ?
Cdt,