Macros retranscrire des données
Bonjour tout le monde,
Je m'y connais un peu en macro mais ce matin j'ai besoin de votre aide.
Au bureau, on travaillais avec la même macro depuis des années et tout fonctionnait bien. Cependant, un collègue à modifié le format du fichier en ajoutant des lignes et des colonnes et depuis ça ne fonctionne plus. J'ai essayé de la corriger la macro mais je crois que ma compréhension n'est pas suffisante.
Il s'agit de la fiche de production d'un produit. Nous conservons l'historique des 5 dernières batch de production. Lors de la production d'une nouvelle batch de produit, la macro "Mise à jour" sert à supprimer les stats les moins récente, décaler l'historique de production de colonnes afin de libérer l'espace pour saisir les données de la nouvelle production.
Concrètement, voici les actions à poser par la macro :
Copier les données des cellules O3 à P60 dans les cellules L3 à N60
Copier les données des cellules R3 à T60 dans les cellules O3 à P60
Copier les données des cellules U3 à W60 dans les cellules R3 à T60
Copier les données des cellules AR3 à AT60 dans les cellules U3 à W60
Enfin, il faut vider les cellules AR3 à AT60 de leur contenues afin qu'elles soient prête à recevoir les nouvelles données.
La macro est dans un deuxième fichier. Je vais donc copier la macro existante plus bas et insérer le fichier test à ce courriel.
Merci à l'avance de votre aide et je vous souhaite une belle journée !!!
Sub Mise_à_jour()
'
' Mise_à_jour Macro
' Macro enregistrée le 99-04-19 par François Paquette
'
'
Range("n3:p76").Select
Selection.Copy
Range("AT3").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
'
Range("Q3:S76").Select
Selection.Copy
Range("N3").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
'
Range("T3:V76").Select
Selection.Copy
Range("Q3").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
'
Range("W3:Y76").Select
Selection.Copy
Range("T3").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
'
Range("B1").Select
Selection.Copy
Range("AY1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B1").Select
Selection.ClearContents
Range("F2").Select
Application.CutCopyMode = False
Selection.Copy
Range("AY2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("F2").Select
Selection.ClearContents
Range("F3").Select
Application.CutCopyMode = False
Selection.Copy
Range("AY3").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("F3").Select
Selection.ClearContents
Range("B5").Select
Application.CutCopyMode = False
Selection.Copy
Range("AY4").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B5").Select
Selection.ClearContents
Range("W3:W5").Select
Selection.ClearContents
Range("X4").Select
Selection.ClearContents
Range("W8:Y31").Select
Selection.ClearContents
Range("W34:Y47").Select
Selection.ClearContents
Range("W3").Value = " "
Range("W4").Value = " "
Range("W5").Value = " "
Range("W3").Select
ActiveWindow.SmallScroll Toleft:=4
End Sub
Bonjour,
Essaie quelque chose comme ça :
Sub Mise_à_jour()
Dim a
a = [O3:Q60].Value
[L3:N60] = a
a = [R3:T60].Value
[O3:Q60] = a
a = [U3:W60].Value
[R3:T60] = a
a = [AR3:AT60].Value
[U3:W60] = a
[AR3:AT60].ClearContents
a = [U7:W7].Value
[AR7:AT7] = a
End SubA+
Bonjour Chantal, bonjour le forum,
C'est pas clair ton histoire !...
Je prends le premier exemple : Copier les données des cellules O3 à P60 dans les cellules L3 à N60
O à P il y a 2 colonnes (O et P) de L à N il y a 3 colonnes (L, M et N) ???
Le second exemple : Copier les données des cellules R3 à T60 dans les cellules O3 à P60
3 colonnes vers 2 colonnes ???
Sinon, pour copier les données des cellules d'un même classeur et dans le même onglet, tu peut utiliser :
Range("L3").Resize(58 ,2).Value=Range("O3:P60").Value58 et 2 étant respectivement le nombre de lignes et le nombre de colonnes de la plage O3:P60.
Sinon, pour copier les données des cellules d'un même classeur, d'un onglet vers un autre onglet, il te faut spécifier l'onglet source et l'onglet destination :
Worksheets("Destination").Range("L3").Resize(58 ,2).Value=Worksheets("Source").Range("O3:P60").ValueSi c'est d'un classeur vers un autre classeur il te faut spécifier le nom du classeur source, le nom de l'onglet source, le nom du classeur destination et le non de l'onglet destination et que les deux classeurs soient ouverts :
Workbooks("Classeur Destination.xlsm").Worksheets("Destination").Range("L3").Resize(58 ,2).Value = Workbooks("Classeur Source.xlsx").Worksheets("Source").Range("O3:P60").ValueDans ce cas, j'utilise des variables du style (à adapter) :
Sub Macro1()
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Set CS = Workbooks("Classeur Source.xlsm") 'définit le classeur source CS (à adapter à ton cas)
Set OS = CS.Worksheets("Feuil1") 'définit l'onglet source OS(à adapter à ton cas)
Set CD = Workbooks("Classeur Destination.xlsx") 'définit le classeur destination CD(à adapter à ton cas)
Set OD = CD.Worksheets("Feuil1") 'définit l'onglet destination OD(à adapter à ton cas)
'après le code est plus simple, on ne spécifie que l'onglet par sa variable
OD.Range("L3").Resize(58, 2).Value = OS.Range("O3:P60").Value
End Sub[Édition]
Ou la méthode de Galopin que je viens de voir et que je salue au passage, bien plus simple...
Merci pour les conseils. J'ai finalement réussi !!!!