Re : fonction avancées en macro
Bonsoir,
Le code n'est pas protégé (lorsque je poste ici, je ne protège jamais mes codes, + ou - 1 seconde pour craker) , c'est un bouton issu de la Barre d'outils Contrôle...
Pour voir le code, va dans l'éditeur VBE (Alt + F11)
pour adapter ce code à ton fichier, rien de plus simple, rejoins un nouveau fichier avec la structure exacte...
Salut,
Je t'envoi ci joint un exemple de la macro que j'ai réactualisé avec les données de tableau;
ça fonctionne mais uniquement en partie
peux tu m'aider
en tout des cas c vachement sympa, tu m'as déjà sortie une bonne aiguille du pied
Sub COPIERDONNEES()
'
' COPIERDONNEES Macro
' Macro enregistrée le 08/03/2008 par mistralincoming
'
'
Derlig = Sheets("Base rens gen Fournisseurs ").[A65000].End(xlUp).Row + 1
Range("U1:U51").Copy
Sheets("Base rens gen Fournisseurs ").Select
Range("A" & Derlig).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Dim pl As Range
Set pl = Range("A3:AY" & Derlig)
pl.Name = "zone_de_tri_renseignements_generaux_fournisseurs"
Set pl = Range("B3:B" & Derlig)
pl.Name = "fournisseurs"
Range("zone_de_tri_renseignements_generaux_fournisseurs").Sort Key1:=Range("A3"), Order1:=xlAscending, Key2:=Range("B3") _
, Order2:=xlAscending, Header:=xlGuess
Sheets("création Fiche Fournisseur").Select
Range("I7:Q27,C7:E7,C9:E9,C11:E11,C16:E16,C18:E18,C20:E20").Select
Range("C20").Activate
ActiveWindow.SmallScroll Down:=19
Range( _
"I7:Q27,C7:E7,C9:E9,C11:E11,C16:E16,C18:E18,C20:E20,C25:E25,C26:E26,C27:E27,C28:E28,K36:M36,D33,D35,D37,D39,D41,D43" _
).Select
Range("D43").Activate
ActiveWindow.SmallScroll Down:=21
Union(Range( _
"K58:M58,K60:M60,K62:M62,K64:M64,K66:M66,I7:Q27,C7:E7,C9:E9,C11:E11,C16:E16,C18:E18,C20:E20,C25:E25,C26:E26,C27:E27,C28:E28,K36:M36,D33,D35,D37,D39,D41,D43,C47:E47,C49:E49,C51:I51,H47,H49:I49,K47:L47,L49:O49,C56:E56,C58:E58" _
), Range("C60:E60,C62:E62,C64:E64,C66:E66,K56:M56")).Select
Range("K66").Activate
ActiveWindow.SmallScroll Down:=11
Selection.ClearContents
Sheets("commentaires").Select
Range("C5:M55").Select
Selection.ClearContents
Sheets("création Fiche Fournisseur").Select
Range("B2:Q3").Select
End Sub
CELLE LA FONCTIONNE A MERVEILLE
PAR CONTRE LORSQUE JE VEUX COPIER UNE AUTRE PLAGE DE DONNEES DE LA MEME FACON (EN NE PRENANT QUE LA VALEUR DES CELLULES)
SUR UNE AUTRE FEUILLE (AUTRE BASE DE DONNEES) ATTRIBUEE POUR LES TARIFS CELA NE FONCTIONNE PAS???????????????
CI-JOINT:
Sub COPIERTARIFS()
'
' copierdonnees2 Macro
' Macro enregistrée le 08/03/2008 par mistralincoming
'
'
Derlig = Sheets("Base rens tarifs fournisseurs ").[A65000].End(xlUp).Row + 1
Range("U52:U307").Copy
Sheets("Base rens tarifs fournisseurs ").Select
Range("A" & Derlig).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Dim pl As Range
Set pl = Range("A3:AY" & Derlig)
pl.Name = "zone_de_tri_tarifs"
Set pl = Range("B3:B" & Derlig)
pl.Name = "fournisseurs2"
Range(" zone_de_tri_tarifs").Sort Key1:=Range("A3"), Order1:=xlAscending, Key2:=Range("B3") _
, Order2:=xlAscending, Header:=xlGuess
Sheets("création Fiche Fournisseur").Select
End Sub
