Extraire des données en vue tableau

  • Initiateur de la discussion Initiateur de la discussion Francis
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Francis

XLDnaute Junior
Bonjour le forum
J’ai réalisé une application pour le travail, mais c’est une vraie usine à gaz.
Il s’agit d’extraire des données de deux colonnes (C et F) en vue de les transposer en un tableau récapitulatif.
J’extrais toutes les valeurs une à une, je les colle dans une ligne puis les transpose
Et donc je suis parti comme ceci

valtest = ""
'*******BRUIT
For i = 2 To NbFeuil
With Sheets(i)
For Each c In .Range("C15:C17")
If c <> valtest Then
.Range(.Cells(Maligne, 4), .Cells(Maligne, 4)) = "BruitT"
End If
Next
End With
Next i
'************Poussieres
For i = 2 To NbFeuil
With Sheets(i)
For Each c In .Range("C33:C40")
If c <> valtest Then
.Range(.Cells(Maligne, 5), .Cells(Maligne, 5)) = "Poussieres"
End If
Next
End With
Next i

Et ainsi de suite pour tous les risques … et c’est une usine à gaz.
puis construction du tableau

'*******Recueil d'infos (boucle sur les feuilles)
'**dans chaque feuille, (les infos sont stockées sur la ligne 90)

For Each sh In ActiveWorkbook.Sheets
If sh.name <> ThisWorkbook.name Then
sh.Activate

Range(Cells(Maligne, 1), Cells(Maligne, 50)).Copy 'copie ligne"90"
With Sheets(1)
.Cells(sh.Index + 8, 2).PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
.Cells(sh.Index + 8, 2) = sh.name 'copie des noms
End With
End If
Next

Je viens auprès de vous pour me donner le canevas de départ pour faire ce tableau afin de me simplifier ces lignes (je me bagarre avec les Ubound et rien ne marche)

La feuille 1 est la feuille de départ une feuille par personne
La feuille 2 est le résultat de mon travail
Merci pour votre aide
Francis
 

Pièces jointes

- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
5
Affichages
707
Réponses
4
Affichages
581
Réponses
2
Affichages
427
Réponses
8
Affichages
651
  • Question Question
Microsoft 365 worksheet_change
Réponses
29
Affichages
1 K
Retour