VBA copier colonne sous condition d'autres colonnes

Bonjour,

Je suis nouvel inscrit et je viens vous demander votre aide car je commence vraiment à être désespéré.

Je cherche à faire un code VBA pour copier une colonne sous condition d'autres colonnes.

Je souhaite copier la colonne A de la feuille « Liste_UO » vers la colonne B de feuille « Juin » avec les contraintes suivantes :

  • Ne pas supprimer les données de la feuille « Juin »
  • La cellule doit contenir « *Excel* » ou « *Poten* »
  • Si la valeur en colonne G de la feuille « Juin », égale à « N/A » ou « Facturée », ne pas copier
  • Si la colonne i de la feuille « Liste_UO » à une date inférieur à la date de début de mois, ne pas copier
  • Si valeur existe déjà dans la colonne B de feuille « Juin », ne pas copier et copier à la ligne d’en dessous

J'ai essayer plein de code qui fonctionnent mal ou très incomplets, donc je vous joint le fichier sans macro.

Merci de votre aide.

53imputation-v1.xlsm (106.22 Ko)

Bonjour,

le problème avec les Tableau de ce genre c'est qu'on ne peut trouver la dernière ligne renseignée,

alors comment savoir ou coller la valeur ?

perso, je ne trouve pas utile cette option Tableau !

Édit:

j'ai écrit trop vite, j'ai finalement trouvé la dernière ligne à renseigner,

à tester,

Sub test()
Set sh1 = Sheets("Liste_UO")
Set sh2 = Sheets("Juin")
Set plg1 = sh1.Range("Tableau_Liste_UO[Code UO]")
Set plg2 = sh2.Range("Tableau_Juin[Nom]")
LastRw2 = sh2.Cells(Range(plg2.Address).Rows.Count, 1).End(xlUp).Row + 1

For Each c In plg1
 If IsError(Application.Match(c, plg2, 0)) Then
  If sh1.Cells(c.Row, "I") >= DateSerial(Year(Date), Month(Date), 1) Then
   If c Like "*Excel*" Or c Like "*Potent*" Then
    sh2.Cells(LastRw2, 1) = c.Value
    LastRw2 = sh2.Cells(Range(plg2.Address).Rows.Count, 1).End(xlUp).Row + 1
   End If
  End If
 End If
Next
End Sub

Bonjour et merci SabV pour ton retour.

Je suis désolé mais le code fait complètement bugguer Excel qui, je pense bloque sur une boucle.

Je continu d'investiguer et joins le fichier pour info.

20imputation-v1-1.xlsm (171.23 Ko)

Bonjour hakkiletah,

« Liste_UO » à une date inférieur à la date de début de mois, ne pas copier

toutes les dates sont inférieur à la date de début de mois, donc il n'y a rien à copier

Excuse moi, je me suis mal exprimé.

Je parlais pas de la date de début du mois en cours, mais de début juin (01/06/2017).

Si la valeur en colonne G de la feuille « Juin », égale à « N/A » ou « Facturée », ne pas copier

il n'y a rien en colonne G de la feuille « Juin » et d'ailleurs rien sur les autre colonnes non plus

Effectivement c'est d'après la colonne G de la feuille "Liste_UO".

Bonjour,

à tester,

Sub test()
Set sh1 = Sheets("Liste_UO")
Set sh2 = Sheets("Juin")
Set plg1 = sh1.Range("Tableau_Liste_UO[Code UO]")
Set plg2 = sh2.Range("Tableau_Juin[Nom]")
LastRw2 = sh2.Cells(Range(plg2.Address).Rows.Count, 1).End(xlUp).Row + 1

For Each c In plg1
x = c.Row
Z = plg1.Address
 If IsError(Application.Match(c, plg2, 0)) Then
  Err.Clear
  If sh1.Cells(c.Row, "F") > DateSerial(Year(Date), 6, 1) Then
   If c Like "*Excel*" Or c Like "*Potent*" Then
     If sh1.Cells(c.Row, "G") = "Facturée" Or sh1.Cells(c.Row, "G") = "N/A" Then
      sh2.Cells(LastRw2, 1) = c.Value
      sh2.Cells(LastRw2, "I") = sh1.Cells(c.Row, "F")
      LastRw2 = sh2.Cells(Range(plg2.Address).Rows.Count, 1).End(xlUp).Row + 1
     End If
   End If
  End If
 End If
Next
End Sub

Salut SabV,

Merci beaucoup ton code m'a bien aidé (je l'ai juste retouché pour inscrire les valeurs que je souhaitais).

Cependant, si je peux encore abuser, je n'arrive pas à changer la destination de la copie de la feuille "Juin" du champs 'Nom' à 'Code UO'.

J'ai essayé de modifier le code sans succès.

Je te joins le fichier excel avec la macro.

50imputation-v2.xlsm (178.10 Ko)

Bonjour,

pour copier le champ Code JIRA de la feuille "Liste_UO"

sur la colonne Code UO de la feuille "Juin"

remplacer:

sh2.Cells(LastRw2, 1) = c.Value

par:

sh2.Cells(LastRw2, 2) = c.Value

Super. Merci beaucoup pour ton aide.

Merci pour ce retour, au plaisir!

pour clôturer le fil, cliquer sur le bouton V vert du post à coté du bouton EDITER, merci!

Super. Merci beaucoup de ton aide.

Bonjour hakkiletah,

je pense avoir décelé un problème sur le code,

si jamais il n'y a pas de données transférées en colonne A, mais en colonne B le calcul de la dernière ligne ne se fait pas.

alors si c'est le cas il faut modifier comme ça,

Sub test()
Set sh1 = Sheets("Liste_UO")
Set sh2 = Sheets("Juin")
Set plg1 = sh1.Range("Tableau_Liste_UO[Code UO]")
Set plg2 = sh2.Range("Tableau_Juin[Code UO]")
LastRw2 = sh2.Cells(Range(plg2.Address).Rows.Count, "B").End(xlUp).Row + 1

For Each c In plg1
x = c.Row
Z = plg1.Address
 If IsError(Application.Match(c, plg2, 0)) Then
  Err.Clear
  If sh1.Cells(c.Row, "F") > DateSerial(Year(Date), 6, 1) Then
   If c Like "*Excel*" Or c Like "*Potent*" Then
     If sh1.Cells(c.Row, "G") = "Facturée" Or sh1.Cells(c.Row, "G") = "N/A" Then
      sh2.Cells(LastRw2, "B") = c.Value
      sh2.Cells(LastRw2, "I") = sh1.Cells(c.Row, "F") ' pour exemple seulement
      LastRw2 = sh2.Cells(Range(plg2.Address).Rows.Count, "B").End(xlUp).Row + 1
     End If
   End If
  End If
 End If
Next
End Sub

Hello,

Je reviens après avoir utilisé avec succès la macro ci-dessous. Cependant il y a un point sur lequel je bute, c'est pour adapter la taille du tableau de destination (Tableau_Liste_UO).

Si le tableau n'est pas assez grand (nombre de ligne) les valeurs ne se copient pas. Savez vous comment je peux faire pour que le tableau de destination s'adapte s'agrandisse si il n'y a plus de place?

Le fichier en pièce jointe

Bonjour,

essayez en remplacent la ligne

LastRw2 = sh2.Cells(Range(plg2.Address).Rows.Count, "B").End(xlUp).Row + 1

par

LastRw2 = sh2.Cells(Rows.Count, "B").End(xlUp).Row + 1

Hello,

Super ça fonctionne.

Je clôture le sujet. Merci pour tous tes conseils

Rechercher des sujets similaires à "vba copier colonne condition colonnes"