macro pour copier coller selon la valeur de la cellule

[mordious]

Bonjour

en fonction de "C2"
je souhaite à l'aide du Bouton 2 lancer une Macro : copier les données de "Feuil1; D635"
dans l'onglet corespondant au choix de :"Feuil1;C2" dans colonne "D"

ci-joint fichier

cordialement

 

[mordious]

Re : macro pour copier coller selon la valeur de la cellule

Bonjour

Un peu plus explicite
Je souhaite

Que la Macro1 de la Feuil1
Copie les données de la Feuil3 dans le TABLEAU 2 et non plus dans le TABLEAU 1
Et que :
La Macro 2 de la Feuil1
Copie les données du TABLEAU 2 vers la Feuil3


ci-joint fichier

cordialement

La seul solution pour la macro1 que j’ai trouvé et de répéter
mais pour la macro2 ???

i = Application.Match([C2], .[4:4], 0)
  If IsNumeric(i) Then [H6] = .Cells(5, i + 0).Resize(31).Value
  If IsNumeric(i) Then [E6] = .Cells(6, i + 0).Resize(31).Value
  If IsNumeric(i) Then [F6] = .Cells(7, i + 0).Resize(31).Value
  If IsNumeric(i) Then [I6] = .Cells(8, i + 0).Resize(31).Value
  If IsNumeric(i) Then [J6] = .Cells(9, i + 0).Resize(31).Value
  If IsNumeric(i) Then [K6] = .Cells(10, i + 0).Resize(31).Value
  If IsNumeric(i) Then [L6] = .Cells(11, i + 0).Resize(31).Value

 

[job75]

Re : macro pour copier coller selon la valeur de la cellule

Bonjour mordious,

Oui il suffit de répéter.

Mais en définissant correctement les plages et en utilisant Transpose :

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [C2]) Is Nothing Then Exit Sub
Dim i As Variant
[H9:N9,H14:N14,H19:N19,H24:N24:H29:J29] = "" 'RAZ
With Feuil3 'CodeName de la feuille Sauvegarde
  i = Application.Match([C2], .[4:4], 0)
  If IsNumeric(i) Then
    [H9:N9] = Application.Transpose(.Cells(5, i + 1).Resize(7).Value)
    [H14:N14] = Application.Transpose(.Cells(12, i + 1).Resize(7).Value)
    [H19:N19] = Application.Transpose(.Cells(19, i + 1).Resize(7).Value)
    [H24:N24] = Application.Transpose(.Cells(26, i + 1).Resize(7).Value)
    [H29:J24] = Application.Transpose(.Cells(33, i + 1).Resize(3).Value)
  End If
End With
End Sub

Private Sub CommandButton1_Click() 'bouton Transfert (ActiveX)
Dim i As Variant
With Feuil3 'CodeName de la feuille Sauvegarde
  i = Application.Match([C2], .[4:4], 0)
  If IsNumeric(i) Then
    .Cells(5, i + 1).Resize(7) = Application.Transpose([H9:N9].Value)
    .Cells(12, i + 1).Resize(7) = Application.Transpose([H14:N14].Value)
    .Cells(19, i + 1).Resize(7) = Application.Transpose([H19:N19].Value)
    .Cells(26, i + 1).Resize(7) = Application.Transpose([H24:N24].Value)
    .Cells(33, i + 1).Resize(3) = Application.Transpose([H29:J24].Value)
    Application.Goto .Cells(4, i) 'sélection facultative
  End If
End With
End Sub

Fichier adapté joint.

Edit : les .Value ne sont pas indispensables, on peut les supprimer.

A+

 

[mordious]

Re : macro pour copier coller selon la valeur de la cellule

Bonjour job75

Excellent
Un grand merci

Mais comme je suis lent à la détente il m’a fallu une ½ heure pour voir la formule dans le TABLEAU 1

=DATE(A2;EQUIV(C2;INDIRECT(donnés!C2);0);1)

et la transposer dans le TABLEAU 2

pour ma culture: et il possible ajouter cette formule dans la Macro1 ?

j'ai rajouter je code suivant mais me copie la valeur de la cellule 1 du mois 1, cellule 2 du mois 2 ......

'CODE KO TRANSPOSE LA 1er CELLULE LE MOIS 1 ,LA 2e CELLULE LE MOIS 2 .......
If Intersect(Target, [C2]) Is Nothing Then Exit Sub
Dim v As Variant
[H7:N7,H12:N12,H17:N17,H22:N22:H27:J27] = "" 'RAZ
With Feuil3 'CodeName de la feuille Sauvegarde
  v = Application.Match([C2], .[4:4], 0)
  If IsNumeric(v) Then
    [H7:N7] = Application.Transpose(.Cells(5, v + 0).Resize(7).Value)
    '[H14:N14] = Application.Transpose(.Cells(12, v + 1).Resize(7).Value)
    '[H19:N19] = Application.Transpose(.Cells(19, v + 1).Resize(7).Value)
    '[H24:N24] = Application.Transpose(.Cells(26, v + 1).Resize(7).Value)
    '[H29:J24] = Application.Transpose(.Cells(33, v + 1).Resize(3).Value)
  End If
End With

et comment lire

v = Application.Match([C2], .[4:4], 0)

EQUIV "recherche (Feuil1;C2 ) Feuil3 (N°LIGNE : N° COLONNE)"

ci-joint fichier

Encore MERCI et bonne soirée

 

[job75]

Re : macro pour copier coller selon la valeur de la cellule

Bonjour mordious, le forum,

Je ne voudrais surtout pas vous vexer mais la manière dont vous traitiez les dates/mois/années était inutilement compliquée.

Voyez ce fichier (5) avec la feuille "Données" et dans les autres feuilles les listes de validation et les formules.

Nota : il y avait des coquilles sur les références des cellules dans les macros, j'ai corrigé.

A+

 

[job75]

Re : macro pour copier coller selon la valeur de la cellule

Re,

Pour faire bon poids j'ai ajouté 2 mises en forme conditionnelles (MFC) en Feuil1.

Sur les plages G27:G30 et H27:J30 qui se masquent suivant le mois.

Fichier (6).

A+

 

[job75]

Re : macro pour copier coller selon la valeur de la cellule

Re,

Concernant les mois de la feuille "Sauvegarde", il est très facile de les construire manuellement par copier-coller.

Si l'on veut le faire par la 2ème macro ça ne mange pas de pain :

Private Sub CommandButton1_Click() 'bouton Transfert (ActiveX)
Dim i As Variant
With Feuil3 'CodeName de la feuille Sauvegarde
  i = Application.Match([C2], .[4:4], 0)
  If IsNumeric(i) Then
    .[B5:B35].Copy .Cells(5, i) 'au cas où ce ne serait pas fait
    If i > 2 Then .Cells(5, i).Resize(31) = .Cells(5, i).Resize(31).Value 'facultatif
    .Cells(5, i + 1).Resize(7) = Application.Transpose([H9:N9])
    .Cells(12, i + 1).Resize(7) = Application.Transpose([H14:N14])
    .Cells(19, i + 1).Resize(7) = Application.Transpose([H19:N19])
    .Cells(26, i + 1).Resize(7) = Application.Transpose([H24:N24])
    .Cells(33, i + 1).Resize(3) = Application.Transpose([H29:J29])
    Application.Goto .Cells(4, i) 'sélection facultative
  End If
End With
End Sub

Bien sûr les lignes 3 et 4 doivent avoir été renseignées.

Et bien sûr il faut des formules particulières pour les jours 29 30 et 31...

Edit : on peut même, pour alléger, ne conserver que les valeurs (7ème ligne).

Fichier (7).

A+

 

[job75]

Re : macro pour copier coller selon la valeur de la cellule

Re,

Pour terminer j'ai supprimé la ligne 3 de la feuille "Sauvegarde", formule en D3 :

=MAJUSCULE(TEXTE(DATE(DROITE(B3;4);MOIS(B3)+1;1);"mmmm aaaa"))

Bien sûr les macros ont dû être adaptées.

Fichier (8).

A+

 

[job75]

Re : macro pour copier coller selon la valeur de la cellule

Re,

Non ce n'est pas fini, encore une chose intéressante.

Dans ce fichier (9) cette macro en feuille "Sauvegarde" crée la liste des mois en Feuil1!C2 :

Private Sub worksheet_Change(ByVal Target As Range)
If Intersect(Target, [3:3]) Is Nothing Then Exit Sub
With Feuil2 'CodeName de la feuille Données
  .[A2].Resize([3:3].Count) = Application.Transpose([3:3])
  .[A:A].SpecialCells(xlCellTypeBlanks).Delete xlUp
  .Range("A2", .Range("A" & .Rows.Count).End(xlUp)).Name = "Mois"
End With
End Sub

Plus besoin de l'année en A2.

A+

 

[mordious]

Re : macro pour copier coller selon la valeur de la cellule

bonjour job75

merci pour tout ,
panne PC donc je test dés que possible
réponse en retour

Je ne voudrais surtout pas vous vexer mais la manière dont vous traitiez les dates/mois/années était inutilement compliquée.

pas du tout , c'est un fichier exemple
étant novice me sert à comprendre avant de l'adapter à mes besoins

encore merci

cordialement

 

[mordious]

Re : macro pour copier coller selon la valeur de la cellule

bonjour job75

changer alim PC

Donc j'ai appliqué toutes les modifs
mais je conserve les liste MOIS/ANNEE

appliqué la formule DATE du Tableau1 au Tableau2

tout ce passe bien


seul souci avec mise en forme si cellule vide (pour les Mois à 28,29,30 jours) avec la barre de gauche

encore Grand merci pour ton aide

ci-fichier

cordialement

 

[job75]

Re : macro pour copier coller selon la valeur de la cellule

Bonsoir mordious,

Pfff... je vois que vous êtes quelqu'un qui aime se compliquer la vie.

A mon âge je fatigue, je vais me coucher.

Bonne nuit.

 

[mordious]

Re : macro pour copier coller selon la valeur de la cellule

ok bonne nuit