Discussion :

[Thechouans]

Bonjour,

Je sollicite votre aide car malgré pas mal d'info sur ce sujet je n'ai pas réussi à réaliser une macro me permettant de faire ce que je souhaites:

J'ai actuellement un fichier eXcel qui possède plusieurs onglets (une 20aine)
Certains onglets possède un planning.
Si un onglet possède un planning, ce planning occupe toujours les mêmes lignes et colonnes (de C60 à AC60)

En revanche le nombre d'onglet possédant un planning peut varier.
Les onglets (qui possède un planning) doivent alimenter l'onglet "récapitulatif". Pour les identifier par rapport aux onglets ne possédant pas de planning j'ai mis un "X" en case A1.

Le but est donc de rapatrier les informations de tous les onglets dont la case A1 est un X dans l'onglet récapitulatif.
Les lignes (1 ligne par onglet: de C60 à AC60) doivent s'afficher les unes après les autres dans le format existant (il y a parfois des mises en forme conditionnelle, elles sont à maintenir). A partir de la cellule A5 de l'onglet récapitulatif (car les lignes précédentes sont déjà utilisées)

Afin de lancer le rapatriement, je souhaites pouvoir le faire depuis un bouton depuis l'onglet récapitulatif. Ce bouton entraînera les étapes suivantes:
1- Suppression des données existantes

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Worksheets("RECAPITULATIF").Range("A5").Offset(3, 0).Select
ActiveSheet.AutoFilterMode = False
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Range("AC5")).Select
Selection.ClearContents

2- Rapatriement des éléments des autres onglets concernés

La je sèche...

Merci de votre aide!!

[blepy]

Bonjour,

Une façon simple de le faire, en étant sûr de traiter tel que souhaité, est de faire un enregistrement de macro.
Ensuite à partir de cette macro enregistrée, il suffira de reprendre le code et l'insérer dans une boucle.

A+

[Philippe Tulliez]

Bonjour,
Pour copier des données et conserver les propriétés de l'objet source, il y a la méthode Copy de l'objet Range avec comme argument Destination.
L'enregistreur de macros ne propose pas cette option mais utilise le copier/coller
Pour faire ce que tu souhaites, il faut faire une boucle (par exemple For Each...In...Next) vérifier s'il y a un x en cellule A1 et effectuer la copie si la condition est remplie.
Au préalable, il faudra vérifier combien de lignes contient déjà la feuille nommée RECAPITULATIF

[Thechouans]

Merci de vos réponses!
J'avance!

Voici le code que j'ai créé:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
For Each ws In Worksheets
If ws.Range("A1") = "X" Then
ws.Range("A59").Copy
Worksheets("RECAPITULATIF").Range("A5").PasteSpecial
ws.Range("B60:AC60").Copy
Worksheets("RECAPITULATIF").Range("B5:AC5").PasteSpecial
End If
Next

Plusieurs problèmes:
1- Toutes les lignes (copiées) des onglets possédant un "X" en A1 sont écrites au même endroit sur l'onglet RECAPITULATIF
Il faut que je créé un code qui puisse décaler d'une ligne l'écriture entre 2 onglets. La encore je cale
2- Je n'arrive pas à enclencher cette macro depuis mon bouton. Bon la je devrai finir par réussir! Mais si vous avez des conseils je suis preneur!

Encore merci!

[BENNASR]

Bonsoir à tous
Une solution bricolée par un autodidacte "clé en main" non recommandée par les membres de ce super forum pour vous incitez à apprendre
alors je réponds et je fouis

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub collecterDonnées()
Application.ScreenUpdating = False 'juste pour arrêter affichage écran et améliorer le temps d'exécution du macro
Dim derligne As Long
j = 5 'tu demande que les données seront classées dans la feuille RECAP à partir de a ligne 5
With Sheets("RECAPITULATIF")
derligne = .Range("A" & Rows.Count).End(xlUp).Row 'chercher la dernière ligne non vide de la feuille RECAP
'*********************************************vider les ligne à partir de la ligne 5
.Range("A5:AA" & derligne).ClearContents
 ' *****************************************Importer les données dans la feuille RECAP
 For i = 1 To Worksheets.Count
        If Worksheets(i).Name <> "RECAPITULATIF" And Worksheets(i).Range("A1") = "X" Then
            Worksheets(i).Range("C60:AC60").Copy .Range("A" & j)
            j = j + 1
        End If
    Next i
End With
Application.ScreenUpdating = True
End Sub

[Thechouans]

Merci!