Problème de copie !!!

[glaine]

Bonjour à tous,

Je voudrais créer un programme dont les grandes lignes générales correspondent
à ceci :
1- sélectionner la cellule dont la valeur est "SOLDE"
2- séléctionner les cellules non vides dans la colonne dessous
la cellule référente
3- si valeur différente de 0 et si valeur différente de "SOLDE" et si
forumule ds cellule différente de " =Somme(G3:G40)"
=>alors :
copie ds 1ère feuille du classeur en cours toutes les lignes des cellules respectant les si.
Mon ébauche donne ceci:
Sub test()
Dim monfichier As Workbook
Dim adr As String
Dim recap As String
Dim direc As Integer
Set monfichier = Workbooks.Open("\\Nwanex\donnees\daf\daf4\B236\2007 FACTURES\CHAPITRE 0214- 02\fourre-tout\LISTE DES FACTURES ET BC 2007 TOURRE TOUT")
monfichier.Worksheets(1).Select
Range("1:1").Select
For Each Item In Selection
If Item.Value = "SOLDE" Then
adr = Item.Address
MsgBox (adr)
End If
Next
Range((adr), Range(adr).End(xlDown)).Select
For i = 1 To Selection.Count
If Cells(i, 7).Value > "0" And Cells(i, 7).Value <> "SOLDE" And _
Cells(i, 7).Formula <> "=SOMME(G3:G40)" Then
recap = Cells(i, 7).Address
direc = Cells(i, 7).Count
Range(recap).EntireRow.Copy ThisWorkbook.Worksheets(1).Range("A2")
ThisWorkbook.Worksheets(1).Activate
MsgBox ("tout marche")
End If
Next
Application.CutCopyMode = False
End Sub
Mon problème est au niveau de la copie. Il prend en bien charge la première valeur, mais s'arrête après. Je ne comprend pas pourquoi. Je suis sous Excel 97. J'espère aussi avoir été à peu près clair. Merci en tous cas pour toute l'aide apportée.

 

[skoobi]

Re : Problème de copie !!!

Bonsoir,
Si je je me trompe pas, toutes tes lignes sont systématiquements copié sur la ligne 2 de ton classeur, c'est à dire que chaque ligne "recap" écrase la ligne 2 de ta cellule de destination A2.
Remplace

Range(recap).EntireRow.Copy ThisWorkbook.Worksheets(1).Range("A2")

par

Range(recap).EntireRow.Copy ThisWorkbook.Worksheets(1).Range("A1").End(XlDown).Offset(1, 0)

en supposant que la cellule A1 n'est pas vide.

Test et dis nous.

 

[glaine]

Re : Problème de copie !!!

Merci pour tes indications. J'avais eu la même idée et j'avais même créé la variable "direc" pour que offset se décale d'autant de valeurs répondant à mes tests if, mais j'ai surtout obtenu l'erreur '1004'. Cela me rendait les choses encore plus obscures. Je suis donc revenu à une forme plus simple :
Range(recap).EntireRow.Copy ThisWorkbook.Worksheets(1).Range("A2")
ou plus propre
Range(recap).EntireRow.Copy ThisWorkbook.Worksheets(1).Rows(2)
Le problème reste entier. J'ai testé ta solution qui m'a renvoyé l'erreur '1004'. En fait, j'ai l'impression que mon programme s'arrête à la première valeur correspondant aux tests if et n'analyse pas le reste de ma sélection. Je cherche donc à lui forcer la main pour qu'il prendre en compte toute les valeurs de ma plage de cellules et je rame dur.
Si je trouve quelque chose, je le signalerai. Merci encore !!!

 

[skoobi]

Re : Problème de copie !!!

Re bonjour,
essaye en déclarant un variable qui fait référence à cette cellule de destination:
Dim dest As Range

tu places sous la boucle For i = ....
Set dest = ThisWorkbook.Worksheets(1).Range("A1").End(XlDown).Offset(1, 0)

puis fait référence à cette variable pour la copie.

 

[glaine]

Petite amélioration !!!

Merci pour tes conseils, j'ai corrigé les choses dans le sens que tu indiquais, mais j'ai toujours le même type d'erreur. J'ai corrigé un peu mon programme :
Sub test()
Dim monfichier As Workbook
Dim adr As String
Dim recap As String
Dim direc As Integer
Dim nbreValeurs As Range
Set monfichier = Workbooks.Open("\\Nwanex\donnees\daf\daf4\B236\2007 FACTURES\CHAPITRE 0214- 02\fourre-tout\LISTE DES FACTURES ET BC 2007 TOURRE TOUT")
monfichier.Worksheets(1).Select
Range("1:1").Select
For Each Item In Selection
If Item.Value = "SOLDE" Then
adr = Item.Address
MsgBox (adr)
End If
Next
Range((adr), Range(adr).End(xlDown)).Select
For i = 1 To Selection.Count
If Cells(i, 7).Value > "0" And Cells(i, 7).Value <> "SOLDE" And _
Cells(i, 7).Formula <> "=SOMME(G3:G40)" Then
recap = Cells(i, 7).Address
direc = Cells(i, 7).Count
Range((recap), Range(recap).Offset(direc)).EntireRow.Copy ThisWorkbook.Worksheets(1).Rows(2)
ThisWorkbook.Worksheets(1).Activate
MsgBox ("tout marche")
End If
Next
Application.CutCopyMode = False
End Sub
J'ai au moins deux valeurs copiées. Je pense maintenant que mon problème est de pouvoir rassembler correctement toutes les valeurs répondant à mes if dans un range pour pouvoir les copier( c'est toujours la galère !!!). La destination ne semble pas poser de problème.
Merci encore.

 

[skoobi]

Re : Problème de copie !!!

Re bonjour,
je pense que le mieux c'est que tu nous envoies un bout de tes 2 fichiers si ce n'est pas confidentiel car ce n'est pas toujours évident d'imaginer ce qu'il se passe dans une macro.