[RESOLU] - MACRO Copier coller sous conditions

DEMERS

XLDnaute Nouveau
Bonsoir à vous
Je vous remercie, par avance, de bien vouloir m'aider pour une MACRO dont la fonction "Copier et Coller" des références situées dans des cellules d'une lignes définie et les affecte (par correspondance de cellules) aux cellules qui ont été sautées et laissées vide.

Des détails et des précisions claires se trouvent sur le fichier ci-joint.

Pour plus de détails, je suis à votre entière disposition pour vous fournir plus de précision.

Mes vives remerciement par avance.
 

Pièces jointes

  • Affectation.xlsm
    13.8 KB · Affichages: 55
Dernière édition:

job75

XLDnaute Barbatruc
Re : MACRO Copier coller sous conditions

Bonsoir DEMERS,

Si le tableau n'est pas très grand on peut le recalculer entièrement à chaque modification de la feuille :

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim designation, plage As Range, ref, t, i&, j As Variant
designation = [B14:B28] 'matrice
Set plage = [C14:Y28] 'Range
ref = [C29:Y29] 'matrice
t = plage 'matrice
For i = 1 To UBound(designation)
  If designation(i, 1) <> 0 Then
    j = Application.Match("*", plage.Rows(i), 0)
    If IsNumeric(j) Then
      For j = 1 To j - 1
        t(i, j) = ref(1, j)
      Next
    End If
  End If
Next
Application.EnableEvents = False: plage = t: Application.EnableEvents = True
End Sub
L'exécution est rapide car on utilise des tableaux VBA (matrices).

Bonne fin de soirée et A+
 
Dernière édition:

DEMERS

XLDnaute Nouveau
Re : MACRO Copier coller sous conditions

Bonsoir Job75
Tout d'abord je te remercie vivement d'avoir pris le temps pour traiter ma demande, je suis bien reconnaissant.
j'ai inséré la macro dans la feuille, mais des fois fonctionne avec lenteur et des fois non.
je ne sais de quoi s'agit-il??

Merci une autre et bonne fin de soirée
A+
 

job75

XLDnaute Barbatruc
Re : MACRO Copier coller sous conditions

Re,

Avec Match la copie ne fonctionne que si l'on entre du texte.

Si l'on veut la même chose avec un nombre utiliser la méthode Find :

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim designation, plage As Range, ref, t, i&, c As Range, j%
designation = [B14:B28] 'matrice
Set plage = [C14:Y28] 'Range
ref = [C29:Y29] 'matrice
t = plage.Formula 'matrice
For i = 1 To UBound(designation)
  If designation(i, 1) <> 0 Then
    Set c = plage.Rows(i).Find("*", , xlValues)
    If Not c Is Nothing Then
      For j = 1 To c.Column - plage.Column
        t(i, j) = ref(1, j)
      Next
    End If
  End If
Next
Application.EnableEvents = False: plage = t: Application.EnableEvents = True
End Sub
Mais c'est moins rapide.

A+
 

DEMERS

XLDnaute Nouveau
Re : MACRO Copier coller sous conditions

Rebonsoir Job
Oui cette fois-ci c'est bon.
juste une remarque
si par exemple je tape une référence dans la 1ère cellule d'une ligne et je saute 2 ou 3 cellules et je tape une référence, les cellules sautées restent vides
donc je dois vous préciser que les cellules peuvent être sautées au milieu ou même avant la dernière cellule

est-ce claire ou je dois encore expliquer?
A+
 

job75

XLDnaute Barbatruc
Re : MACRO Copier coller sous conditions

Re,

Comme j'ai une insomnie et que ce n'est pas trop difficile :

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim designation, plage As Range, ref, t, ncol%, i&, flag As Boolean, j%
designation = [B14:B28] 'matrice
Set plage = [C14:Y28] 'Range
ref = [C29:Y29] 'matrice
t = plage 'matrice
ncol = UBound(t, 2)
For i = 1 To UBound(designation)
  If designation(i, 1) <> 0 Then
    flag = False
    For j = ncol To 1 Step -1
      If t(i, j) <> "" Then flag = True Else If flag Then t(i, j) = ref(1, j)
    Next
  End If
Next
Application.EnableEvents = False: plage = t: Application.EnableEvents = True
End Sub
Bonne nuit.
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
312 185
Messages
2 086 009
Membres
103 089
dernier inscrit
johnjohn1969