Macro recopie data fin du fichier sans reprendre les existants

[undo]

Bonjour à tous et bonne année 2008,

Je souhaite trouver une macro qui vient rajouter des données dans un autre fichier à la suite du fichier.

Exemple et condition!

Nous avons deux fichiers : fich1 (Source), fich2 (destination) et Fich3 (resultat)

a) je veux supprimer les datas parasite du fich1 (ligne 1 à ligne 7).
b) je veux copier les datas de la colonne B (B2 à B+n) et la même chose sur la colonne D vers le fich2

Condition:

Je ne dois pas recopier les datas existant dans le fich2.


Merci pour votre support.
Salutation
Undo

 

[skoobi]

Re : Macro recopie data fin du fichier sans reprendre les existants

Bonjour,

voici une macro à mettre dans fich1:

Sub test()
Dim prenom As Range, prenom2 As Range, addresse As Range
Rows("1:7").Clear
For Each prenom In Range([B9], [B9].End(xlDown))
    Set addresse = prenom.Offset(0, 2)
    With Workbooks("fich2.xls").Sheets("Feuil1")
        Set prenom2 = .Cells.Find(prenom.Value, LookIn:=xlValues)
        If prenom2 Is Nothing Then Set prenom2 = .Range("A65536").End(xlUp).Offset(1, 0)
        prenom2 = prenom
        prenom2.Offset(0, 2) = addresse
    End With
Next
Workbooks("fich2.xls").Sheets("Feuil1").Activate
End Sub

 

[undo]

Re : Macro recopie data fin du fichier sans reprendre les existants

Bonjour skoobi,

Merci pour ta réponse mais il y a pb car les datas existant sont remplace par la macro le but c'est de seulement rajouter à la suite du fichier sans touché à l'historique.
merci

slt
undo

 

[skoobi]

Re : Macro recopie data fin du fichier sans reprendre les existants

Re bonjour,

voici le code corrigé:

Sub test()
Dim prenom As Range, prenom2 As Range, addresse As Range
Rows("1:7").Clear
For Each prenom In Range([B9], [B9].End(xlDown))
    Set addresse = prenom.Offset(0, 2)
    With Workbooks("fich2.xls").Sheets("Feuil1")
        Set prenom2 = .Cells.Find(prenom.Value, LookIn:=xlValues)
[B][COLOR="Red"]        If prenom2 Is Nothing Then
            Set prenom2 = .Range("A65536").End(xlUp).Offset(1, 0)
            prenom2 = prenom
            prenom2.Offset(0, 2) = addresse
        End If[/COLOR][/B]
    End With
Next
Workbooks("fich2.xls").Sheets("Feuil1").Activate
End Sub