Vba transférer vers un autre classeur avec condition Résolu/Fermé

Question

Bonjour les amis, 
J'ai une macro pour but de transférer les données d'un classeur source vers un classeur cible, la macro s'exécute  sans problème mais j'ai voulu ajouter une condition pour que les données se transfèrent  si et seulement si les deux marges de cellules C10:C100 des deux classeurs contiennent exactement les mêmes données , mais la macro s’arrête au niveau de la 11éme 
Merci d'avance.
Sub Exporter()
Application.ScreenUpdating = False
Dim Fich As String
Dim CD, ar, el as range
Fich = Application.GetOpenFilename
Sheets("tut1").Activate
CD = ActiveSheet.Range("F10:AD100")
ar = ActiveSheet.Range("C10:C100")
Workbooks.Open (Fich)
Sheets("Tuteur").Activate
el = ActiveSheet.Range("C10:C100")
If ar <> el Then
MsgBox "Ce n'est pas le bon fichier !"
ActiveWorkbook.Close SaveChanges:=False
Else
Range("F10:AD100") = CD
ActiveWorkbook.Close SaveChanges:=True
End If
End Sub



Configuration: Windows / Chrome 100.0.4896.88

Le Pingou · Answer

Bonjour,
Vous avez défini la variable [el] comme [Range] et de ce fait votre ligne 11 doit être:
Set el = ActiveSheet.Range("C10:C100")

noe2008 · Answer

Salut Le pingou je viens d'ajouter votre modification mais la macro s'arrete au niveau de la 12 eme ligne :       If ar <> el Then

Le Pingou · Answer

Bonjour,
Et que vous dit le message d'erreur....?
C'est normal car vous comparez 2 variables dont [ar] est de type Variant et [el] de type Range.

noe2008 · Answer

bonjour,
le message de debogage
erreur d'execution
incompatibilité de type

Le Pingou · Answer

Bonjour,
Le voici exactement:


Je vois que vous voulez comparer deux plages de données, alors il faut faire une boucle sur les données pour les comparer une à une.....

noe2008 · Answer

bonjour, 
mes connaissances sont limitées en vba , si vous pouvez me régler ce problème je serai tres reconnaissant.

Le Pingou · Answer

Bonjour,
Une proposition à adapter selon vos besoins:
Sub test()
Dim ar As Variant, el As Variant
ar = ActiveSheet.Range("A10:A100")
el = ActiveSheet.Range("C10:C100")
For c = 1 To UBound(ar)
    If ar(c, 1) <> el(c, 1) Then
        MsgBox "Ce n'est pas le bon fichier !"
        rep = noOk
        Exit For
    End If
Next c
If re = "noOK" Then
    ActiveWorkbook.Close SaveChanges:=False
Else
    Range("F10:AD100") = ar
    ActiveWorkbook.Close SaveChanges:=True
End If
End Sub

Vba transférer vers un autre classeur avec condition

7 réponses

Discussions similaires

Newsletters