Copier coller vba automatique
vicctoria90
-
Utilisateur anonyme -
Utilisateur anonyme -
Bonjour,
Voilà je souhaite copier des cellules d'un fichier dans un autre sous excel, pour cela, j'ai créé cette écriture avec laquelle ça marche.
Seulement je souhaite automatiser cela de sorte que dès que je saisi mon texte dans ma cellule de mon fichier 1, la cellule de mon fichier 2 se remplisse automatiquement.
Merci de m'aider
Vicctoria
Sub COPIER()
'Selectionne et Copie la Cellule indiquée
'
'Macro1 Macro
'Macro enregistrée le 02/02/2009 par auberta
'
Windows("NOTE DE FRAIS.xls").Activate
Sheets("Feuil1").Activate
Range("D8").Copy
'End Sub
'Sub COLLER()
'Selectionne puis Colle la Première Cellule Vide à partir de la Cellule indiquée
'
Windows("Budget deplacement 2009.xls").Activate
Sheets("2009").Select
Range("B44").Select
Do While ActiveCell.Value > ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveSheet.Paste
End Sub
Voilà je souhaite copier des cellules d'un fichier dans un autre sous excel, pour cela, j'ai créé cette écriture avec laquelle ça marche.
Seulement je souhaite automatiser cela de sorte que dès que je saisi mon texte dans ma cellule de mon fichier 1, la cellule de mon fichier 2 se remplisse automatiquement.
Merci de m'aider
Vicctoria
Sub COPIER()
'Selectionne et Copie la Cellule indiquée
'
'Macro1 Macro
'Macro enregistrée le 02/02/2009 par auberta
'
Windows("NOTE DE FRAIS.xls").Activate
Sheets("Feuil1").Activate
Range("D8").Copy
'End Sub
'Sub COLLER()
'Selectionne puis Colle la Première Cellule Vide à partir de la Cellule indiquée
'
Windows("Budget deplacement 2009.xls").Activate
Sheets("2009").Select
Range("B44").Select
Do While ActiveCell.Value > ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveSheet.Paste
End Sub
Configuration: Windows XP Firefox 3.0.5
1 réponse
-
Bonjour,
Placer ce code derrière la feuille [ Feuil1] du classeur [ NOTE DE FRAIS.XLS ] :
A chaque changement de valeur de [ D8 ], celle-ci est recopié à la suite dans l'autre classeur.
Private Sub Worksheet_Change(ByVal Target As Range) Dim Plage As Range, Intersection As Range Dim Position As Long, Feuille As String Feuille = ActiveSheet.Name Set Plage = Range("D8") Set Intersection = Application.Intersect(Target, Plage) If Not (Intersection Is Nothing) Then Target.Copy Workbooks("Budget deplacement 2009.xls").Activate Sheets("2009").Range("B14").Select Position = Sheets("2009").Range("B14:B65536").End(xlDown).Row + 1 Sheets("2009").Range("B" & Position).Select ActiveSheet.Paste Application.CutCopyMode = False Workbooks("NOTE DE FRAIS.xls").Activate Sheets(Feuille).Select End If End Sub '
Lupin
