Etendre le champ d'action d'une macro enregistrée

[Aloha]

Bonjour à vous tous,

J'ai enregistré le code suivant (je l'ai déjà modifié/complété un peu: j'ai ajouté "For n = 4 to..." , et j'ai remplacé "Sheets([nom de la feuille]).Select" par "Sheets(n).Select"), que je voudrais maintenant appliquer à toutes les feuilles du classeur, à partir de la 4ème feuille:

Sub (xy)

For n = 4 To Workbook.Sheets.Count
Sheets(n).Select
Range("K4:W52").Select
Selection.Copy
Sheets("Tout").Select
Range("B1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks: = _False, Transpose:=False
Range("B51").Select
...
...
...

End Sub

Ce que je voudrais faire:
copier dans toutes les feuilles, à partir de la 4ème, les données dans K4:W52 et les coller comme valeur dans la feuille "Tout", les données de la 4e dans B1:..la 5ème dans B51:.., la 6e dans B101:... etc.

Comment faut-il modifier le code pour y arriver?

D'avance merci pour toute aide

Aloha

[wilfried_42]

Bonjour, Aloha

Sub copie()
sheets("Tout").select ' Selection de la feuille ou je dois coller
For n = 4 To Workbook.Sheets.Count
Sheets(n).Range("K4:W52").Copy ' la selection n'et pas nécessaire pour copier : gain de temps
' ((N-4)*50) au premier passage n = 0 *50 = 0 +1 = 1, au 2eme n-4 = 1 *50 = 50 + 1 = 51 etc.....
.Range("B" & 1 + ((n-4)*50).Select ' Selection obligatoire pour un pastespecial -->
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks: = _False, Transpose:=False
next n ' Prochaine feuille
Range("B1").select ' Selection de B1 sur feuille "tout"
End Sub

[Aloha]

Bonjour Wilfried,

merci beaucoup.

Pas bête cette astuce pour toujours coller dans la bonne cellule.

Je dois dire que le but que je veux atteindre par ce code n'est pas le but final, mais seulement intermédiaire.

Je m'explique: en réalité toutes les lignes dans K4:W52 ne contiennent pas des données, la taille est variable. La solution plus élégante et plus rationnelle consisterait donc à copier uniquement les lignes contenant des données et de les coller toujours, non pas à partir d'une cellule fixe, mais toujours dans la première ligne libre.

Cependant, je m'y étais déjà mis il y a un an à peu près, et ça na jamais fonctionné, malgré l'aide de plusieurs spécialistes. Le hic: les données dans K4:W52 ne sont pas saisies manuellement, mais elles sont produites par des formules, ce qui signifie donc que, même si à partir d'une certaine ligne dans K4:W52 aucune donnée n'est affichée, les cellules ne sont pas vides pour autant, puisqu'elles contiennent des formules (l'utilité de cette méthode: je dois disposer des données saisies manuellement de telle façon à ce qu'elles soient conformes, en ce qui concerne leur structure, à la feuille dans laquelle je dois les coller (située dans un autre classeur; je veux par le présent code seulement mettre toutes les données ensemble pour les coller alors manuellement à leur destination finale).

Mon premier essai, l'année passée, n'a pas permis d'exclure les lignes contenant seulement des formules, et non pas des données. Voilà pourquoi j'ai imaginé ce système moins élégant, moins efficace et moins automatique (puisque je dois encore trier les données collées, pour avoir toutes les lignes contenant des données dans un bloc).

Si maintenant il y avait tout de même une possibilité d'aller plus loin, je ne m'en plaindrais pas.

J'espère avoir su m'expliquer compréhensiblement.

Aloha

[wilfried_42]

re:

Sub copie()
sheets("Tout").select ' Selection de la feuille ou je dois coller
For n = 4 To Workbook.Sheets.Count
Sheets(n).Range("K4:W52").Copy ' la selection n'et pas nécessaire pour copier : gain de temps
' ((N-4)*50) au premier passage n = 0 *50 = 0 +1 = 1, au 2eme n-4 = 1 *50 = 50 + 1 = 51 etc.....
Range("B" & 1 + ((n-4)*50).Select ' Selection obligatoire pour un pastespecial -->
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks: = _False, Transpose:=False
next n ' Prochaine feuille
Range("B1").select ' Selection de B1 sur feuille "tout"
End Sub

essaye cela :

Sub copie()
sheets("Tout").select ' Selection de la feuille ou je dois coller
For n = 4 To Workbook.Sheets.Count
' sheets(n).range("K65000").end(xlup).row ---> donne la derniere ligne pleine
Sheets(n).Range("K4:W" & sheets(n).range("K65000").end(xlup).row).Copy ' la selection n'et pas nécessaire pour copier : gain de temps
' .range("B65000").end(xlup).row + 1 ---> donne la prochaine ligne vide
Range("B" & range("B65000").end(xlup).row + 1).Select ' Selection obligatoire pour un pastespecial -->
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks: = _False, Transpose:=False
next n ' Prochaine feuille
Range("B1").select ' Selection de B1 sur feuille "tout"
End Sub

[Aloha]

Salut,

J'ai essayé.
Excel ne veut pas accepter: Range("B" & 1 + ((n-4)*50).Select (tu l'avais mis comme remarque, mais c'est ça le bon code pour coller toujours dans la bonne cellule? et le point avant Range, il faut bien l'omettre?)

Excel dit: Erreur de compilation - Erreur de syntaxe

Aloha

[wilfried_42]

re:

je ne sais pa pourquoi j'ai mis des . surement la sieste à faire lol

Voici une macro qui devrait(si je n'ai pas la tete ailleur!!!) fonctionner

Sub copie()
sheets("Tout").select ' Selection de la feuille ou je dois coller
For n = 4 To Workbook.Sheets.Count
' sheets(n).range("K65000").end(xlup).row ---> donne la derniere ligne pleine
Sheets(n).Range("K4:W" & sheets(n).range("K65000").end(xlup).row).Copy ' la selection n'et pas nécessaire pour copier : gain de temps
' range("B65000").end(xlup).row + 1 ---> donne la prochaine ligne vide
Range("B" & range("B65000").end(xlup).row + 1).Select ' Selection obligatoire pour un pastespecial -->
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks: = _False, Transpose:=False
next n ' Prochaine feuille
Range("B1").select ' Selection de B1 sur feuille "tout"
End Sub

[Aloha]

Excuse si je persiste.

Maintenant Excel trouve un problème dans:

For n = 4 To Workbook.Sheets.Count

Le code en entier:

Sub Copier_toutes_les_donnees_dans_une_feuille()
'
' Copier_toutes_les_donnees_dans_une_feuille Macro
' Macro enregistrée le 31/05/2007 par FMPO
'
Application.Calculation = xlCalculationManual

For n = 4 To Workbook.Sheets.Count

Sheets(n).Range("K4:W" & Sheets(n).Range("K65000").End(xlUp).Row).Copy
Sheets("Tout").Select
Range("B" & Range("B65000").End(xlUp).Row + 1).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Next n
End Sub


Aloha

[Pierrot93]

Bonjour Aloha, Wilfried

remplaces peut être :

For n = 4 To Workbook.Sheets.Count

par :

For n = 4 To ThisWorkbook.Sheets.Count

a condition que ton classeur ait au moins 4 feuilles.

bon après midi
@+

[Aloha]

Merci Pierrot, ça fonctionne maintenant.

Seulement, Wilfried (et Pierrot), j'ai de nouveau le même problème: Excel copie également les cellules apparemment vides, mais contenant des formules, de sorte que les données provenant de la deuxième feuille copiée commencent bien à la cellule B52, alors que je n'avais introduit que 2 lignes dans la première feuille copiée!

Il faudrait donc une fonction qui sache distinguer les cellules contenant des valeurs produites par une formule des cellules contenant la formule ne donnant aucune valeur.

Aloha

[wilfried_42]

re:

il est vrai que des cellules contenant des formules sont comptabilisés, il va falloir travailler sur les valeurs

function derligne(plage as range) as long
dim i as long
for i = plage.count to 1 step-1
if plage(i).value >"" then exit for
next i
derligne = i
end function

et

Sheets(n).Range("K4:W" & derligne(Range("K4:K" & sheets(n).range("K65000").end(xlup).row))).Copy

Mais la, je n'ai jamais testé, sans aucune conviction, mais cela semble logique

[Aloha]

Merci Wilfried pour ta réponse ultrarapide.

Seulement, que dois-je faire de ça? Comment et où l'intégrer dans mon code?

Aloha

P.S.: j'espère ne pas trop t'énerver en venant tout le temps "à charge", mais sans aide je suis perdu dans les méandres de ce dode.

[wilfried_42]

re:

excuse moi, c'est moi qui n'ai pas precisié....

un fonction est ecrite et doit se mettre à l'exterieur du sub, dans un module, mais il y a une erreur dans la ligne à modifier

Sheets(n).Range("K4:W" & derligne(Range("K4:K" & sheets(n).range("K65000").end(xlup).row))).Copy

devient :

Sheets(n).Range("K4:W" & 4+derligne(Range("K4:K" & sheets(n).range("K65000").end(xlup).row))).Copy

et prend l place de la ligne en rouge

Sub copie()
sheets("Tout").select ' Selection de la feuille ou je dois coller
For n = 4 To Workbook.Sheets.Count
' sheets(n).range("K65000").end(xlup).row ---> donne la derniere ligne pleine
Sheets(n).Range("K4:W" & sheets(n).range("K65000").end(xlup).row).Copy ' la selection n'et pas nécessaire pour copier : gain de temps
' range("B65000").end(xlup).row + 1 ---> donne la prochaine ligne vide
Range("B" & range("B65000").end(xlup).row + 1).Select ' Selection obligatoire pour un pastespecial -->
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks: = _False, Transpose:=False
next n ' Prochaine feuille
Range("B1").select ' Selection de B1 sur feuille "tout"
End Sub

je ne sais pas si je me suis bien fait comprendre lol, je n'ai pas la fibre d'un pedagogue

[Aloha]

Salut,

La macro tourne, mais maintenant elle ne copie rien.

La macro:
Sub Copier_toutes_les_donnees_dans_une_feuille()
'
' Copier_toutes_les_donnees_dans_une_feuille Macro
' Macro enregistrée le 31/05/2007 par FMPO
'
Application.Calculation = xlCalculationManual

For n = 6 To ThisWorkbook.Sheets.Count
Sheets(n).Range("K4:W" & 4 + derligne(Range("K4:K" & Sheets(n).Range("K65000").End(xlUp).Row))).Copy
Sheets("Tout").Select
Range("B" & Range("B65000").End(xlUp).Row + 1).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Next n

End Sub
La fonction, je l'ai introduite dans un nouveau module et en haut à gauche il est marqué "Général". C'est ok, ça?

Aloha

[wilfried_42]

re:

oui c'est bon, et je viens de tester la fonction, elle est Ok, ca devrait fonctionner, elle me renvoie bien le nombre de lignes qui contiennent des valeurs

envoie le fichier en enelevvant un max de ligne, si ca fonctione avec une feuille, ca fonctionne avec toutes

[Aloha]

salut,

que veux-tu dire par "envoie le fichier"? tu veux dire que je dois l'"uploader"?

Aloha