Copier cellule par rapport aux données d'une autre

[kknd04]

Bonjour,

Je reviens vous demander de l'aide.

En effet, je cherche a faire copier les infos de cellules a un emplacement de x colonne a droite (nombre de colonnes noté dans une cellule) et de une, deux ou plus de lignes en bas (constant pour les cellules donnants le nombre de colonnes)

Exemple :

Les colonnes "jours" sont divisées en deux, E-f, G-H etc.
La ligne 4 donne le nombre de jours de d'écart pour la copie.
Les lignes 5 et 6 contiennent les cellules a copier, on copie les cellules de droite dans une colonne jour, et on les colle dans les cellules gauche de la colonne jour donnée..
Les cellules F5 et F6 devraient êtres déplacées de 10 jours (EF4) donc en cellule : Y5 et Y6

Le nombre de colonnes est facile a calculer, on fait une l'opération 10*2-1
Par contre je ne sais pas comment demander a Excel de copier ces cellules en changeant de ligne et en prenant en compte la cellule EF4, dans notre exemple, dont la valeur doit être modifiable a volonté et les mises en formes de la cellule copier respectées (couleur, gras, fond, contour etc.).

Comme un fichier est plus simple a comprendre je vous place en pce jointe ce dernier.

J'espère avoir été suffisamment clair dans mes explications.

Merci d'avance pour votre aide encore une fois.

 

[kknd04]

Re : Copier cellule par rapport aux données d'une autre

Personne n'a d'idée?

SVP aidez moi.

 

[job75]

Re : Copier cellule par rapport aux données d'une autre

Bonjour kknd04

Voyez cette macro dans le code de la feuille (clic droit sur l'onglet et Visualiser le code) :

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [E4:F6]) Is Nothing Then Exit Sub
Dim plage As Range, n As Byte
Set plage = [E4:F6]
1 With plage(2, 2).Offset(, 2 * (Val(plage(1, 1)) + n) - 1).Resize(2)
  If Application.CountA(.Cells) Then
    If MsgBox("Le jour est occupé, décaler d'un jour ?", 4) = 6 Then
      n = n + 1
      GoTo 1
    End If
  ElseIf n = 0 Then
    With plage(2, 3).Resize(2, 46)
      .ClearContents 'RAZ
      .ClearComments
    End With
  End If
  plage(2, 2).Resize(2).Copy .Cells
  .Borders(xlEdgeRight).LineStyle = xlNone 'effacement de la bordure
End With
End Sub

A+

 

[job75]

Re : Copier cellule par rapport aux données d'une autre

Re,

Si l'on effaçait E4 ça n'allait pas, j'ai complété :

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [E4:F6]) Is Nothing Then Exit Sub
Dim plage As Range, d As Long, n As Byte
Set plage = [E4:F6]
d = Int(Val(plage(1, 1)))
1 With plage(2, 2).Offset(, 2 * (d + n) - 1).Resize(2)
  If d > 0 And Application.CountA(.Cells) Then
    If MsgBox("Le jour est occupé, décaler d'un jour ?", 4) = 6 Then
      n = n + 1
      GoTo 1
    End If
  ElseIf n = 0 Then
    With plage(2, 3).Resize(2, 46)
      .ClearContents 'RAZ
      .ClearComments
    End With
  End If
  If d > 0 Then
    plage(2, 2).Resize(2).Copy .Cells
    .Borders(xlEdgeRight).LineStyle = xlNone 'effacement de la bordure
  End If
End With
End Sub

Fichier (2).

Nota : je n'ai pas prévu d'alerte avant l'effacement (RAZ).

Si vous en voulez une dites-le.

A+

 

[job75]

Re : Copier cellule par rapport aux données d'une autre

Re,

J'avais fait une erreur en définissant la variable plage, j'ai modifié les posts #3 et #4.

A+

 

[kknd04]

Re : Copier cellule par rapport aux données d'une autre

Bonjour Job75,

Merci de ton aide et de ton VBA.

Je suis intéressé par un avertissement pour confirmer ou non le remplacement d'une cellule par celle copiée.

Je dois avouer que je ne suis pas expert avec les formules Excel "rares", mais je parviens a les comprendre un peu avec pas mal de recherche et de test.
Mais alors le VBA, je suis complètement perdu. Pourrais tu m'aider a comprendre celui que tu a posté? Des annotations ou autres?
Bien sur, si cela ne te dérange pas.
La je n'arrive pas par exemple a ce que la copie fonctionne pour toutes la ligne 5 de EF a "infinie"
Ou bien par exemple si je décide de changer de lignes ou de cellules a copier etc.

Cela me permettrais d'utiliser ce VBA pour d'autres zones, pages voir d'autres travaux plutôt que de vous déranger.

Merci beaucoup a toi (je tutoie, j'espère que ca ne te gène pas ou gène le forum)

 

[job75]

Re : Copier cellule par rapport aux données d'une autre

Bonjour kknd04,

Le tutoiement ne me gêne pas, même si j'ai plutôt l'habitude de vouvoyer.

J'ai revu la macro :

- je distingue maintenant la cellule E4 (cel) de la plage F5:F6 (plage)

- j'ai mis une alerte pour l'effacement des copies réalisées

- il suffit de lire chaque ligne de code pour comprendre ce qu'elle fait, quand on ne comprend pas un mot voir l'aide VBA.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [E4:F6]) Is Nothing Then Exit Sub
Dim cel As Range, plage As Range, d As Long, n As Byte
Set cel = [E4] 'à adapter
Set plage = [F5:F6] '2 cellules, l'une sous l'autre
d = Int(Val(cel)) 'nombre entier
1 With plage.Offset(, 2 * (d + n) - 1)
  If d > 0 And Application.CountA(.Cells) Then
    If MsgBox("Le jour est occupé, décaler d'un jour ?", 4) = 6 Then
      n = n + 1
      GoTo 1 'on recommence tant qu'une cellule vide n'est pas trouvée
    End If
  ElseIf n = 0 Then
    If MsgBox("Effacer toutes les copies réalisées ?", 4) = 6 Then
      With plage(1, 2).Resize(2, Columns.Count - plage.Column)
        .ClearContents 'efface les données
        .ClearComments 'efface les commentaires
      End With
    End If
  End If
  If d > 0 Then
    plage.Copy .Cells
    .Borders(xlEdgeRight).LineStyle = xlNone 'efface la bordure
  End If
End With
End Sub

Fichier (3).

A+

 

[kknd04]

Re : Copier cellule par rapport aux données d'une autre

Merci,

Je ne comprend pas comment faire pour que cela fonctionne aussi sur les autres cellules de la ligne 4. Par exemple de E4 a IV4, voir plus car je suis sous xlsx.

J'ai mis ":" et ";" dans "Set cel = [E4] 'à adapter", mais ca ne fonctionne pas, il est vrais que le VBA ne ressemble pas du tout aux formules de Excel "classique" que je connais.

Merci beaucoup pour les annotations qui me permette de comprendre mieux la "formule"

 

[job75]

Re : Copier cellule par rapport aux données d'une autre

Re,

Avant d'essayer de "faire fonctionner" sur d'autres cellules de la ligne 4 il faut définir ce qui doit se passer.

Par exemple si l'on entre une valeur en G4 quelle plage doit être copiée ?

Au post #1 on ne parle que de F5:F6.

Et quel est le but de tous ces copier-coller ? Que voulez-vous obtenir finalement ?

A+

 

[kknd04]

Re : Copier cellule par rapport aux données d'une autre

Il est vrais que je n'ai peut être pas été suffisamment clair dans ma demande et dans mon fichier.
En fait, F5 et F6 corresponde a des produits entrée le jour F4, et tous les jours il y a de nouveaux produits potentiels.
De plus les produits peuvent se multiplier en fonctions de chacun, un nombre de jours est possible et souvent différent. Ce qui explique les copies et aussi pourquoi les cellules de la ligne 4.

Si on extrapole, on peut imaginer une entrée en jour 10 (W3) qui se "multiplie" en x jours (W4) et donc la copie de la plage X5:X6 en jour 21 (AS5 et AS6).
Bien sur ce sont toutes les cellules de la ligne 4 qui sont utiles car chaque jour peut, et dans le temps, sera avec un produit,, se qui demandais une sécurité avant de coller(les messages de confirmations)

Je me demande si je suis vraiment plus clair comme ca ^^'

 

[job75]

Re : Copier cellule par rapport aux données d'une autre

Re,

Alors je pense qu'à la place d'une Worksheet_Change il faut une Worksheet_BeforeDoubleClick :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, [E4].Resize(, Columns.Count - 4)) Is Nothing Then Exit Sub
Dim plage As Range, d As Long, n As Byte
Cancel = True
Set plage = Target(2, 2).Resize(2) '2 cellules, l'une sous l'autre
d = Int(Val(Target(1))) 'nombre entier
1 With plage.Offset(, 2 * (d + n) - 1)
  If d > 0 And Application.CountA(.Cells) Then
    If MsgBox("Le jour est occupé, décaler d'un jour ?", 4) = 6 Then
      n = n + 1
      GoTo 1 'on recommence tant qu'une cellule vide n'est pas trouvée
    End If
  ElseIf n = 0 Then
    If MsgBox("Effacer toutes les copies réalisées ?", 4) = 6 Then
      With plage(1, 2).Resize(2, Columns.Count - plage.Column)
        .ClearContents 'efface les données
        .ClearComments 'efface les commentaires
      End With
    End If
  End If
  If d > 0 Then
    plage.Copy .Cells
    .Borders(xlEdgeRight).LineStyle = xlNone 'efface la bordure
  End If
End With
End Sub

Un double-clic en ligne 4 déclenche la copie de la plage du dessous.

Fichier (4).

A+

 

[kknd04]

Re : Copier cellule par rapport aux données d'une autre

Si je comprend bien le double clique indique que le VBA doit fonctionner sur la cellule en question.

Je vois juste un petit problème, quand la demande : "Effacer toutes les copies réalisées ?" si je clic oui cela efface la totalité des données
Vous voyez un peux le problème? Est il possible de conditionner a la seul cellule cible?

 

[job75]

Re : Copier cellule par rapport aux données d'une autre

Bonjour kknd047,

Est il possible de conditionner a la seul cellule cible?

Il y a une alerte spécifique pour la plage cible si elle n'est pas vide :

"Le jour est occupé, décaler d'un jour ?"

Dans le cas contraire une 2ème alerte demande si l'on veut tout effacer.

Si vous ne voulez jamais rien effacer, eh bien retirez ce code :

ElseIf n = 0 Then
    If MsgBox("Effacer toutes les copies réalisées ?", 4) = 6 Then
      With plage(1, 2).Resize(2, Columns.Count - plage.Column)
        .ClearContents 'efface les données
        .ClearComments 'efface les commentaires
      End With
    End If

A+

 

[kknd04]

Re : Copier cellule par rapport aux données d'une autre

Oups,

Oui je me suis mélangé les pinceaux.

Merci pour tout

 

[kknd04]

Re : Copier cellule par rapport aux données d'une autre

J'ai tout de même une question, si je souhaite créer de nouvelles lignes avec le même effet, dois je recopier le même code ou faut il ajouter dans l'existant de nouvelles données?

Par exemple si je souhaite que la ligne 10 et/ou 16,22 etc. fassent des copies des cellules F11/12, F17/18, F23/24 etc. avec les mêmes règles et réglages bien sur.