Copier Coller sur colonne dynamique
Bonjour à tous,
Ceci est mon premier post sur le forum car cela fait plusieurs jours que je peine à trouver une solution à mon problème..
Je souhaite réaliser une macro qui me permettrai de copier la cellule B15 et de la coller en formule, puis en valeur dans les colonnes (et de la ligne 23 à 212 ) dont l’entête (ROW 18) contient les arguments énoncés en F11, F12,F13
Par exemple, nous sommes en month = Feb, year = 2016, criteria = Bud, je viens copier B15 et la coller en H23:H212 et I23:I212
Cependant, et c'est là ou je coince réellement c'est que le noms de colonnes peut changer, je veux donc créer une macro "dynamique"
J'avais pensé a déclarer ma ligne 18 en tant de tableau dyn style
dim tab1()
et créer une condition, if month and year and criteria Like row(18) then
range("B15").COPY => Activecell.offset(-5,0) 'difference de ligne entre l'entete ligne 18 et le debut de la colonne a coller ligne 23
Enfin... je n'arrive pas à trouver de solutions qui réponde à mon envie...
En espérant une aide de votre part,
Merci d'avance, amis excelophile
je vous joins le doc
Antoine
Une idee quelqu'un ? =)
Salut Antoine,
quelque chose comme ça?
Attention à te (et nous aussi!
Par exemple :
- les mois de ta liste commencent par une minuscule là où il faudra comparer les majuscules de ton tableau ;
- dans ta liste, 'Act ' était suivi d'une espace, cause d'erreur dans mes premiers tests.
Private Sub Worksheet_Change(ByVal Target As Range)
'
Application.EnableEvents = False
Application.ScreenUpdating = False
'
If Not Intersect(Target, Range("F11:F13")) Is Nothing Then
If [F11] <> "" And [F12] <> "" And [F13] <> "" Then
sFlag = Left([F11], 3) & [F12] & [F13]
iCol = Cells(18, Columns.Count).End(xlToLeft).Column
sCol1 = Split(Columns(iCol).Address(ColumnAbsolute:=False), ":")(1)
For x = 2 To iCol
If sFlag = Cells(18, x) Then
sCol2 = Split(Columns(x).Address(ColumnAbsolute:=False), ":")(1)
iRow = Range("A" & Rows.Count).End(xlUp).Row
Cells(23, x).FormulaLocal = "=SOMME($A$1:$A$4)"
Range("B23:" & sCol1 & iRow).Borders.LineStyle = xlLineStyleNone
Range(sCol2 & 23).AutoFill Destination:=Range(sCol2 & "23:" & sCol2 & iRow), Type:=xlFillDefault
Range("B23:" & sCol1 & iRow).BorderAround LineStyle:=xlContinuous, Weight:=xlMedium
Range("F11:F13").ClearContents
Exit For
End If
Next
End If
End If
'
Application.ScreenUpdating = True
Application.EnableEvents = True
'
End SubA+
curulis57 a écrit :Salut Antoine,
quelque chose comme ça?
Attention à te (et nous aussi!
) faciliter la tâche en créant des listes de validation identiques et faciles d'utilisation! Par exemple :
- les mois de ta liste commencent par une minuscule là où il faudra comparer les majuscules de ton tableau ;
- dans ta liste, 'Act ' était suivi d'une espace, cause d'erreur dans mes premiers tests.
Private Sub Worksheet_Change(ByVal Target As Range) ' Application.EnableEvents = False Application.ScreenUpdating = False ' If Not Intersect(Target, Range("F11:F13")) Is Nothing Then If [F11] <> "" And [F12] <> "" And [F13] <> "" Then sFlag = Left([F11], 3) & [F12] & [F13] iCol = Cells(18, Columns.Count).End(xlToLeft).Column sCol1 = Split(Columns(iCol).Address(ColumnAbsolute:=False), ":")(1) For x = 2 To iCol If sFlag = Cells(18, x) Then sCol2 = Split(Columns(x).Address(ColumnAbsolute:=False), ":")(1) iRow = Range("A" & Rows.Count).End(xlUp).Row Cells(23, x).FormulaLocal = "=SOMME($A$1:$A$4)" Range("B23:" & sCol1 & iRow).Borders.LineStyle = xlLineStyleNone Range(sCol2 & 23).AutoFill Destination:=Range(sCol2 & "23:" & sCol2 & iRow), Type:=xlFillDefault Range("B23:" & sCol1 & iRow).BorderAround LineStyle:=xlContinuous, Weight:=xlMedium Range("F11:F13").ClearContents Exit For End If Next End If End If ' Application.ScreenUpdating = True Application.EnableEvents = True ' End Sub
A+
Salut curulis57 et encore merci de t'être penché sur mon cas,
Tu as raison, je devrais être plus rigoureux dans mes listes déroulantes, désolé..
J'essaye d'utiliser ta macro mais je ne sais pas où la coller, je vois que c'est un Private Sub et Excel me demande de créer une macro..
Alors je ne comprend pas trop comment faire, je n'ai jamais utilisé de Private Sub.. je ne peux donc pas encore tester ton code
Est-ce que tu pourrais m'expliquer s'il te plaît et mettre des petits commentaires vert dans ton code pour me l'expliquer car là c'est un peu charabiesque pour moi
Merci encore;
A+
Salut Antoine,
première chose à éviter : ne reproduis pas tous les messages qu'on t'envoie! On sait ce qu'on a écrit!
La macro est déjà en place dans le fichier joint! Il te suffit de remplir les cellules F11...F13 à l'aide de tes listes de validation et le calcul se fait tout seul! Pas compliqué, quand même!
Private Sub Worksheet_Change(ByVal Target As Range)
' procédure qui agit lors d'un changement sur une cellule (Change!!)
Application.EnableEvents = False
Application.ScreenUpdating = False
'
'si ce changement a lieu en F11, F12 ou F13
If Not Intersect(Target, Range("F11:F13")) Is Nothing Then
' si les 3 cellules sont complétées...
If [F11] <> "" And [F12] <> "" And [F13] <> "" Then
' construction (concaténation) du contenu des F11... à l'image de tes rubriques de colonne
sFlag = Left([F11], 3) & [F12] & [F13]
' calcul du nombre de colonnes de ton tableau, pour savoir jusqu'où chercher
iCol = Cells(18, Columns.Count).End(xlToLeft).Column
' calcul de la lettre correspondant à cette dernière colonne
sCol1 = Split(Columns(iCol).Address(ColumnAbsolute:=False), ":")(1)
For x = 2 To iCol
' recherche par comparaison de la colonne à traiter
If sFlag = Cells(18, x) Then
' lettre correspondant à cette colonne
sCol2 = Split(Columns(x).Address(ColumnAbsolute:=False), ":")(1)
' calcul de la hauteur de cette colonne
iRow = Range("A" & Rows.Count).End(xlUp).Row
' on colle la formule sur la première cellule de la colonne
Cells(23, x).FormulaLocal = "=SOMME($A$1:$A$4)"
' effacement de l'encadrement pour éviter un affichage incohérent dû à la recopie qui suivra
Range("B23:" & sCol1 & iRow).Borders.LineStyle = xlLineStyleNone
' recopie de la formule dans la colonne
Range(sCol2 & 23).AutoFill Destination:=Range(sCol2 & "23:" & sCol2 & iRow), Type:=xlFillDefault
' on remet le cadre
Range("B23:" & sCol1 & iRow).BorderAround LineStyle:=xlContinuous, Weight:=xlMedium
' effacement des F11... pour une nouvelle recherche
Range("F11:F13").ClearContents
Exit For
End If
Next
End If
End If
'
Application.ScreenUpdating = True
Application.EnableEvents = True
'
End SubA+
Ah oui en effet je viens de voir qu'elle n'a pas besoin d'être lancée pour fonctionner => cf Cours VBA
Cependant lorsque je selectionne des valeurs dans les listes déroulantes en F11 F12 F13 , rien ne se passe
j'ai copié la macro dans la première feuille et ensuite dans le Worbook entier, rien à faire,
Pourrais tu m'expliquer ?
ou Re-uploader le fichier avec la macro enregistrée au bon endroit ?
Merci encore pour les commentaires dans ton code, cela m'a beaucoup aidé à mieux comprendre
a+
Salut Antoine,
ça fonctionne très bien ici!
Envoie quelques feuilles de ton fichier de travail réel, stp, avec des explications claires et complètes sur ce que tu cherches exactement
Dans le vide, très difficile de t'aider plus!
A+
Ah bravo je suis découvert, je vais t'envoyer mon fichier de travail demain (un peu édulcoré bien-sur, charte de confidentialité professionnelle oblige)
je te joindrais avec ca une feuille qui contiendra toutes les explications
merci encore de ton implication c'est vraiment appréciable et sympa de ta part
A+,