VBA macro de copie sous condition ne fonctionne pas

[superbog]

Bonjour,

j'ai une macro qui doit permettre de mettre à jour un fichier clients pour qu'il soit identique au fichier clientsTest. Lorsque la macro est lancée, le but est de comparer les cellules et en cas de différence, de recopier la ligne source dans le fichier fille (clients) et de décocher la cellule A de la ligne correspondant (pour me permettre un traitement ensuite)

malheureusement ma macro ne fonctionne pas bien...

ci joint les fichiers exemples, voici la macro

Sub clients_TP()
Dim Sh1 As Worksheet, Sh2 As Worksheet, lig&, I&

Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si le fichier est ouvert
Workbooks.Open ThisWorkbook.Path & "\clients.xlsx" 'chemin à adapter
Set Sh1 = ThisWorkbook.Sheets("clients")
Set Sh2 = Workbooks("clients.xlsx").Sheets("Feuil1")
lig = Sh1.Range("B9000").End(xlUp).Row + 1

For I = 2 To Sh2.Range("C9000").End(xlUp).Row
  'Copie les valeurs si non identiques
  If Sh2.Cells(I, 5).Value <> Sh1.Cells(I, 5).Value Or Sh2.Cells(I, 6).Value <> Sh1.Cells(I, 6).Value Or Sh2.Cells(I, 7).Value <> Sh1.Cells(I, 7).Value Or Sh2.Cells(I, 8).Value <> Sh1.Cells(I, 8).Value Or Sh2.Cells(I, 12).Value <> Sh1.Cells(I, 12).Value Or Sh2.Cells(I, 13).Value <> Sh1.Cells(I, 13).Value Or Sh2.Cells(I, 14).Value <> Sh1.Cells(I, 14).Value Then
     Sh1.Cells(lig, 2).Resize(, 16) = Sh2.Cells(I, 2).Resize(, 16).Value
 
      lig = lig + 1
  
  End If
Next I

Sh2.Parent.Close True 'facultatif, enregistre et ferme le fichier clients.xlsm
Application.ScreenUpdating = True
MsgBox "opération effectuée"
End Sub

pouvez vous m'aider?

 

[Yaloo]

Re : VBA macro de copie sous condition ne fonctionne pas

Bonsoir superbog, le forum,

Je ne suis pas sur d'avoir compris, mais :

Cells(I, 1) = ""

avant

lig = lig + 1

devrait faire l'affaire.

A+

Martial

 

[job75]

Re : VBA macro de copie sous condition ne fonctionne pas

Bonjour superbog, yalou, le forum,

j'ai une macro qui doit permettre de mettre à jour un fichier clients pour qu'il soit identique au fichier clientsTest.

Alors il suffit de copier toutes les lignes, inutile de cocher quoi que ce soit :

Sub clients_TP()
Dim Sh1 As Worksheet, Sh2 As Worksheet

Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si le fichier est ouvert
Workbooks.Open ThisWorkbook.Path & "\clients.xlsx" 'chemin à adapter
Set Sh1 = ThisWorkbook.Sheets("clients")
Set Sh2 = Workbooks("clients.xlsx").Sheets("Feuil1")

Sh2.Range("A1:P" & Sh2.Rows.Count).Delete xlUp 'RAZ
Sh1.Range("A1:P1", Sh1.Cells(Sh1.Rows.Count, 2).End(xlUp)).Copy Sh2.[A1]

Sh2.Parent.Close True 'facultatif, enregistre et ferme le fichier clients.xlsx
Application.ScreenUpdating = True
MsgBox "opération effectuée"
End Sub

Fichiers joints, à télécharger sur le bureau pour tester.

A+

 

[job75]

Re : VBA macro de copie sous condition ne fonctionne pas

Re,

Il ne faut pas supprimer la 1ère ligne si l'on veut conserver la largeur des colonnes dans clients.xlsx :

Sh2.Range("A2:P" & Sh2.Rows.Count).Delete xlUp 'RAZ

A+

 

[job75]

Re : VBA macro de copie sous condition ne fonctionne pas

Re,

En fait on peut utiliser tout bêtement :

Sub clients_TP()
Dim Sh1 As Worksheet, Sh2 As Worksheet

Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si le fichier est ouvert
Workbooks.Open ThisWorkbook.Path & "\clients.xlsx" 'chemin à adapter
Set Sh1 = ThisWorkbook.Sheets("clients")
Set Sh2 = Workbooks("clients.xlsx").Sheets("Feuil1")

Sh1.Cells.Copy Sh2.[A1]

Sh2.Parent.Close True 'facultatif, enregistre et ferme le fichier clients.xlsx
Application.ScreenUpdating = True
MsgBox "opération effectuée"
End Sub

Et je découvre que ça fonctionne aussi si l'on remplace le fichier client.xlsx par client.xls.

A+

 

[superbog]

Re : VBA macro de copie sous condition ne fonctionne pas

oui, c'est plus simple

il y avait juste une erreur de sens, je voulais copie sh2 sur sh1. j'ai retourné la formule, ca marche

merci