Macro Copier cellule avec formule
Bonjour,
D' abord merci pour ce site, j'apprends beaucoup de choses.
Cependant je suis coincé sur un probléme sur excel 2003.
Je voudrais avec un bouton transférer les données d'une feuille "selection" sur une autre feuille"devis estimatif". Les données sont filtrées suivant si dans la colonne A le symbole "X" est sélectionné en manuel.
Pour le moment la copie fonctionne...., sauf que je viens de m'apercevoir que les cellules ne copient pas les formules sur la feuille "devis estimatif", seulement la valeur .
comment puis je faire pour copier la formule (ce sont des formules d'addition , multiplication)
Merci d'avance
A+
ci dessous le programme:
Sub Filtre()
Range("o2") = "=AND(a2=""x"")"
Range("a1:m" & Range("c65000").End(xlUp).Row).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
Range("o1:o2"), CopyToRange:=Sheets("devis estimatif").Range("a1:m1"), Unique:=False
Range("o2").ClearContents
End Sub
Bonjour
Peux-tu envoyer un fichier exemple (en Excel)
Cordialement
Bonsoir
Voici un fichier exemple
dans la feuille "devis estimatif" la cellule copier en G3 à perdu sa formule "=E8*F8" de la feuille "selection"
Merci
Bonjour
Code Module1
Sub Transfert()
Application.ScreenUpdating = False
Sheets("SELECTIONS").Select
Sheets("SELECTIONS").Copy After:=Sheets(3)
Range("A2:A" & [A65000].End(xlUp).Row).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Range("B2", Range("B65000").End(xlUp).Offset(0, 11)).Copy
Sheets("devis estimatif").Activate
Range("B2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Application.DisplayAlerts = False
Sheets("SELECTIONS (2)").Delete
Range("B1").Select
Application.DisplayAlerts = True
End SubCordialement
Bonjour Amadeus
Je commence par un MERCI.
Je viens d'essayer la programme, et je suis très content du résultat.
MERCI; ENCORE Amadeus pour ta dispo.
A+++
loa
Bonjour Amadeus
Je viens de remarquer que la selection dans la colonne A avec un "X", dans la feuille "selection" permet de transferer la ligne, mais en désélectionnant, , la ligne est toujours transfert dans la feuille "estimatif devis"
Tu peux me donner un coup de main pour garder la possibilitée de sélectionner une ligne ou non
Merci
lao
Bonjour
Je suis parti sur 300 lignes, tu changeras si besoin
Code de Feuille "SELECTIONS"
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("A2:A300")) Is Nothing And Target.Count = 1 Then
Call Transfert
End If
End Subet Code Module1
Sub Transfert()
Application.ScreenUpdating = False
Sheets("devis estimatif").Activate
Range("A2:M300").ClearContents
Sheets("SELECTIONS").Activate
ActiveSheet.Copy After:=Sheets(3)
Application.EnableEvents = False
Range("A2:A300").SpecialCells(xlCellTypeBlanks).EntireRow.Delete Range("A2", Range("A65000").End(xlUp).Offset(0, 11)).Copy
Range("A2", Range("A300").End(xlUp).Offset(0, 11)).Copy
Sheets("devis estimatif").Activate
Range("A2").Select
ActiveSheet.Paste
Range("A2:A300").ClearContents
Application.CutCopyMode = False
Application.DisplayAlerts = False
Application.EnableEvents = True
Sheets("SELECTIONS (2)").Delete
Range("B1").Select
Application.DisplayAlerts = True
End SubCordialement