Copier >1 cellules de >1 feuilles sur onglet récapitulatif [Résolu/Fermé]

Signaler
Messages postés
15
Date d'inscription
dimanche 15 décembre 2013
Statut
Membre
Dernière intervention
3 juin 2018
-
Messages postés
15
Date d'inscription
dimanche 15 décembre 2013
Statut
Membre
Dernière intervention
3 juin 2018
-
Bonjour,

J'ai fait un poste hier, mais sur une discussion résolu. Comme il me semble que ma question n'a pas ou est très rarement soulevée une interrogation.

La réponse la plus proche que j'ai trouvé est:
https://forums.commentcamarche.net/forum/affich-11770347-copier-la-meme-cellule-de-plusieurs-onglets#p33859046
J'ai donc essayé de progresser autour de ce qui y était proposé, mais j'ai vite buté sur mon manque de connaissances de la programmation VBA.

j'ai donc posté ma question hier en suite de cette discussion, mais comme celle-ci est cloturée, je crains que mon nouveau post ne soit pas visible.

Je réitère donc ma demande içi:

Bonjour,

Introduction
D'abord je me présente, Technico-commercial, je suis plus à l'aise avec le téléphone et des sujets de mécanique qu'avec les macro, sauf s'ils sont aux barbecue accompagnés de Vino Verde (pour les plus lusitaniens d'entre nous).
Donc: pour faire une macro, où je lance l'enregistrement de ce que je fait pour le répéter ensuite: Check je sais faire).
Mais alors faire une macro où il y'a de la programmation pur et dur... je maîtrise pas encore... soyons honnête: pas du tout!
J'ai essayé de trouver un forum où quelqu’un avait exactement mon problème... mais je n'ai pas réussi à trouver. J'ai essayé de bidouiller avec les différentes réponses, mais entre les boucles, All Worksheet et la syntaxe... c'est un peu (beaucoup, (passionnément), à la folie) dur et pas très intuitif. J'ai essayé de regarder ce que proposaient les cours en lignes de macro, mais il faut faire tout un cursus, certainement très intéressant, mais je vais passer 3 semaines avant de réunir toute les compétences pour réaliser ma macro! Et ce matin, je tombe sur ce message. C'est quasiment ce que je veux... mais... mais pas tout à fait...
Alors laissez moi vous présenter ma :

Problématique:
J'ai un classeur avec X onglets:
les Y (=10) premiers ne m’intéressent pas ici,
Les différents onglets Z suivants, sont chacun dédiés à un de mes clients. Bien entendu, chacun des onglets est au nom du client concerné. Il ne s'appelle pas Z1, puis Z2, puis Z3 etc etc.
Sur l'onglet A -nommé: "To Do Clients" et directement à la suite des onglets clients (Z)- je souhaiterais compiler le contenu de certaines cellules des différents onglets Z (voir § "objectif" ci dessous)
L'onglet B -nommé: "To Do prospect" et directement à la suite de l'onglet A- est celui où je compile les informations de mes prospects. La macro y a été crée en utilisant la fonction "magnétoscope" des macros excel.
Notons que ni A ni B ne renvoie de résultats pour les cellules quand nous iront chercher les valeurs dans tous les onglets.

Objectif:
Dans l'onglet A, en partant de la la cellule A2, je voudrais que la macro me copie le résultats de 3 cellules de chacun des onglets Z.
A2 pour la première valeur du 1er client, B2 pour la deuxième valeur du 1er client, et C2 pour la troisième valeur du 1er client.
Puis A3 A2 pour la première valeur du 2ème client, B3 etc etc...
Pour simplifier la macro et partir d celle de Lermite222, j'ai copié pour tout les onglets.
Puis, je supprime les lignes 2 à 11 afin de retirer les informations renvoyées par les Y premiers onglets.
Les cellules à renvoyer sont respectivement: I3, B1, J3.

Limites de mes compétences:
D'abord, je n'y connais rien et c'est bien là mon plus grand problème.
Ensuite, le code de lermite222 est ce que j'ai trouvé de plus proche.
Alors j'ai brodé autour:

"""""""""""""""
Sub RappelR6()
Dim Lig As Long, Col As Integer
Dim Wk As Worksheet
Lig = 2 'Première ligne où copier
Col = 1 'Colonne où copier
For Each Wk In Worksheets
If Wk.Name <> "To Do Clients" Then
Sheets("To Do Clients").Cells(Lig, Col) = Wk.Range("I3")
Lig = Lig + 1
End If
Next Wk

Rows("2:11").Select
Range("A11").Activate
Selection.ClearContents
Selection.Delete Shift:=xlUp


Range("A2:C2001").Select
ActiveWorkbook.Worksheets("To Do Clients").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("To Do Clients").Sort.SortFields.Add Key:=Range( _
"A2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("To Do Clients").Sort
.SetRange Range("A3:A61")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

End Sub
"""""""""""""""
et ma foie on est pas mal... mais il me faudrait faire 3 macros pour I3, B1 et J3. Mais alors, je perdrai mon tri par date...

Alors, tel un candidat de télé réalité qui crois avoir atteint le star system car il à fait la couverture de podium, j'ai essayé:

""""""""""""""
Sub RappelR6()
Dim Lig As Long, Col As Integer
Dim Wk As Worksheet
Lig = 2 'Première ligne où copier
Col = 1 'Colonne où copier
For Each Wk In Worksheets
If Wk.Name <> "To Do Clients" Then
Sheets("To Do Clients").Cells(Lig, Col) = Wk.Range("I3")
Lig = Lig + 1
End If
Next Wk

Dim Lig As Long, Col As Integer
(...)
Lig = 2 'Première ligne où copier
Col = 2 'Colonne où copier
(...)
Sheets("To Do Clients").Cells(Lig, Col) = Wk.Range("B1")
Lig = Lig + 1
End If
Next Wk

Dim Lig As Long, Col As Integer
(...)
Lig = 2 'Première ligne où copier
Col = 3 'Colonne où copier (...)
Sheets("To Do Clients").Cells(Lig, Col) = Wk.Range("J3")
Lig = Lig + 1
End If
Next Wk

Rows("2:11").Select
(...) xlSortNormal
With ActiveWorkbook.Worksheets("To Do Clients").Sort
(...)
End With

End Sub

""""""""""
Et bien sur, cela n'a pas fonctionné: "erreur de compilation: Déclaration existante dans la portée en cours".
Alors j'ai supprimé: "Dim Lig As Long, Col As Integer"
même message d'erreur, Alors j'ai essayé en supprimant:
"Dim Wk As Worksheet"
même message d'erreur.

Et je me suis dit:
Tu ne sais pas où commence et où fini et comment fonctionne Sub Rappel!
que changer le chiffre de "Col =" n'était peut être pas suffisant pour changer de colonne...
...
...
...
Moment de solitude...

Enfin, voila, je crois que je sais bricoler, mais là, j'ai besoin d'un mécano.

Ma demande est-elle claire? Pourriez-vous m'aider à finaliser cette macro? Merci de votre aide.

Willywill

1 réponse

Messages postés
15
Date d'inscription
dimanche 15 décembre 2013
Statut
Membre
Dernière intervention
3 juin 2018

J'ai trouvé!!!

uen fois la première extract' réalisée, j'ai été dans la cellule adjacente (Range("B2").Select, puis Range("B3").Select)
A posteriori, je me demande si ces lignes csont nécessaires,

en dessus j'ai collé tout le texte de ce qui me semblait être la macro qui m'interressait, ( de "Dim Lig As Long, " à "Next Wk"

J'ai dégagé le dimensionnement du début de ma macro. En effet, j'ai eu des message de Erreur de compilation du débogueur qui me disait: "Déclaration existante dans la portée en cours". Sans savoir ce que je faisais, j'ai supprimé d'abord:
Dim Lig As Long, Col As Integer
et comme cela bugait encore, j'ai supprimé:
Dim Wk As Worksheet

J'ai modifié "Col = 1 'Colonne où copier" en mettant 2 pour B2 et 3 pour C2 (c'est pour cela que je pense que venir en B2 et C2 avant la macro est inutile)

Et voila ma première macro faite en programmation... oserai-je dire: "la première macro numérique". Parceque vu comment j'ai galéré, je pense que mon cerveau n'est pas composé que de 0 et de 1... je crois m^me qu'on est plusieurs dans ma tête à l'utiliser! et c'est pas toujours moi qui le préempte!

Donc ma macro finale:
"""""""""""""""""""""""
Sub RappelR6()
Dim Lig As Long, Col As Integer
Dim Wk As Worksheet
Lig = 2 'Première ligne où copier
Col = 1 'Colonne où copier
For Each Wk In Worksheets
If Wk.Name <> "To Do Clients" Then
Sheets("To Do Clients").Cells(Lig, Col) = Wk.Range("I3")
Lig = Lig + 1
End If
Next Wk

Range("B2").Select
Lig = 2 'Première ligne où copier
Col = 2 'Colonne où copier
For Each Wk In Worksheets
If Wk.Name <> "To Do Clients" Then
Sheets("To Do Clients").Cells(Lig, Col) = Wk.Range("B1")
Lig = Lig + 1
End If
Next Wk

Range("B3").Select
Lig = 2 'Première ligne où copier
Col = 3 'Colonne où copier
For Each Wk In Worksheets
If Wk.Name <> "To Do Clients" Then
Sheets("To Do Clients").Cells(Lig, Col) = Wk.Range("J3")
Lig = Lig + 1
End If
Next Wk


Rows("2:11").Select
Range("A11").Activate
Selection.ClearContents
Selection.Delete Shift:=xlUp


Range("A2:C2001").Select
ActiveWorkbook.Worksheets("To Do Clients").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("To Do Clients").Sort.SortFields.Add Key:=Range( _
"A2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("To Do Clients").Sort
.SetRange Range("A3:A61")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

End Sub