VBA copier la colonne feuil Excel sous des conditions

Bonjour ,

J'ai deux fichiers excel . Le premier comporte des references et des noms des clients "source.xlsm" , alors que deuxieme porte la meme chose mais avant une mise ajour ,

comment peut on creer une macro qui permet de mettre ajour cette colonne ? on verifiant que la reference n'existe pas dans le tableau ? ainsi de l'ajouter a la derniere ligne de la colonne si elle l'a trouvé ? j'ai fais ce code la mais il me donne rien :s HELP

Sub Recopy()
Dim sourceWb As Workbook
Dim sourceSheet As Worksheet
Dim destWb As Workbook
Dim destLast As Integer
Dim destSheet As Worksheet
Dim Lastlign As Integer
Dim myLoop As Integer
'## Open both workbooks
Dim i As Long

Set sourceWb = Workbooks.Open("C:\Users\Desktop\Source.xlsm")
Set sourceSheet = sourceWb.Worksheets("Clients")

Set destWb = Workbooks("Destination.xlsm")
Set destSheet = ThisWorkbook.Worksheets("Feuil1")
Lastlign = sourceSheet.Cells(sourceSheet.Rows.Count, 1).End(xlUp).Row

For myLoop = 6 To Lastlign 
    sourceVal = sourceSheet.Range("G" & myLoop).Value
       With destSheet.Range("A:A")
        Set oFound = .Find(sourceVal)
        If oFound Is Nothing Then
        Exit Sub
        Else
           destLast = destSheet.Cells(destSheet.Rows.Count, 1).End(xlUp).Row + 1
           ' set value in destination sheet
           destSheet.Range("A" & destLast).Value = sourceVal
           i = i + 1
        End If
    End With
Next

sourceWb.Close True

End Sub

[/code]

Bonjour

Essaie ce code :

Sub Recopy()
Dim sourceWb As Workbook
Dim sourceSheet As Worksheet
Dim destWb As Workbook
Dim destLast As Integer
Dim destSheet As Worksheet
Dim Lastlign As Integer
Dim myLoop As Integer
'## Open both workbooks
Dim i As Long

    'Set sourceWb = Workbooks.Open("P:\Desktop\Nouveau dossier\Source.xlsm")
    Set sourceWb = Workbooks("Source.xlsm")
    Set sourceSheet = sourceWb.Worksheets("clients")

    Set destWb = ThisWorkbook 'Workbooks("clients.xlsm")
    Set destSheet = destWb.Sheets("Feuil1")
    Lastlign = sourceSheet.Cells(Rows.Count, 1).End(xlUp).Row

    For myLoop = 2 To Lastlign
        sourceval = sourceSheet.Range("A" & myLoop).Value
           With destSheet.Range("A:A")
            Set oFound = .Find(sourceval)
            If Not oFound Is Nothing Then
                Exit Sub
            Else
               destLast = destSheet.Cells(destSheet.Rows.Count, 1).End(xlUp).Row + 1
               Range(sourceSheet.Range("A" & myLoop), sourceSheet.Range("A" & myLoop).Offset(0, 2)).Copy _
                        destSheet.Range("A" & destLast)
               i = i + 1
            End If
        End With
    Next myLoop
End Sub

Bye !

il s'execute une seule fois , mais apres quand je supprime les lignes dessous pour le tester il ne marche pas

jeanDebois a écrit :

...mais apres quand je supprime les lignes dessous pour le tester il ne marche pas

Je suis désolé mais je ne comprends pas ce que tu veux dire...

Bye !

@gmb , le code marche bien quand le tableau dans le fichier destination est vide ! mais quand il est remplie et quand veux ajouter au dessous de la derniere ligne il ne marche pas et il ouvre le fichier source

Nouvelle version.

Bye !

@gmb merciii beaucoupp !!! une derniere question , comment peut on definir qu'on veut copier seulement les 2 premieres colonnes ( seulement le nom et la reference ?) sans copier les villes

et est ce que tu pourras m'expliquer pourquoi Range("A" & myLoop).Offset(0, 2) ?

c'est bon j'ai compris ! merciii

Nouvelle version.