XL 2016 Consolidation de données issues de plusieurs feuilles

[L_Wa]

Bonjour à tous,

Dans un tableur, je souhaite consolider les données de plusieurs feuilles (même plage par exemple A8:J10). Le code fonctionne avec une seule feuille mais pas lorsque j'essaie de rechercher dans plusieurs feuilles (voir tableur en PJ). Le code en question est le suivant :

Sub essairech()

' essairech Macro

Worksheets("Feuil3").Select
Range("A8:J10").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("RECHERCHE").Select
Range("A4").Select
ActiveSheet.Paste

End Sub

Dans la page RECHERCHE, le bouton "consolider chimie" me permet d'aller chercher les données de la Feuil3 présentes dans la plage A8:J10.

Dès que j'essaie de remplacer "Feuil3" par "Chimie1 to Chimie2" qui me servent de repères dans le tableur (début et fin des onglets chimie) cela ne fonctionne pas.

Avez-vous une idée ?

Si c'est possible je souhaite éviter de consolider les lignes vides

D'avance merci

 

[youky(BJ)]

Bonjour L_Wa,
L'onglet RECHERCHE doit rester en 1ere place
La macro prend toutes les autres pages.
Bruno

Sub essairech()
'RECHERCHE doit être en 1er
For onglet = 2 To Sheets.Count
lig = Sheets("RECHERCHE").[A65000].End(3).Row + 1
bas = Sheets(onglet).[A65000].End(3).Row
If bas > 7 Then
Sheets(onglet).Range("A8:J" & bas).Copy
Sheets("RECHERCHE").Range("A" & lig).PasteSpecial
End If
Next
Application.CutCopyMode = False
End Sub

 

[L_Wa]

Bonjour @youky(BJ)

Tout d'abord merci ! Le problème avec ce code est que je consolide toutes les autres feuilles (voir PJ) :

Je souhaite uniquement consolider les onglets bleus (consolidation chimie)

La macro a consolidé également les données présentes dans l'onglet rouge

 

[youky(BJ)]

Re,
Pas vu de couleurs dans le fichier.
Je prends seulement si le nom de l'onglet commence par "Chimie"
Bruno

Sub essairech()
dim onglet,bas,lig
For onglet = 1 To Sheets.Count
If Left(Sheets(onglet).Name, 6) = "Chimie" Then
bas = Sheets(onglet).[A65000].End(3).Row
If bas > 7 Then
lig = Sheets("RECHERCHE").[A65000].End(3).Row + 1
If lig < 3 Then lig = 3
Sheets(onglet).Range("A8:J" & bas).Copy
Sheets("RECHERCHE").Range("A" & lig).PasteSpecial
End If
End If
Next
Application.CutCopyMode = False
End Sub

 

[L_Wa]

Merci @youky(BJ) ! Cela me semble fonctionner, dernier sujet :

Je souhaite aussi récupérer le nom du système présente dans la plage G3:J3 et dans l'idéal le copier avant les lignes relatives aux interventions. j'ai ajouté la ligne en gras à votre code :

Sub essairech()
Dim onglet, bas, lig
For onglet = 1 To Sheets.Count
If Left(Sheets(onglet).Name, 6) = "Chimie" Then
bas = Sheets(onglet).[A65000].End(3).Row
If bas > 7 Then
lig = Sheets("RECHERCHE").[A65000].End(3).Row + 1
If lig < 3 Then lig = 3


Sheets(onglet).Range("G3:J3").Select

Sheets(onglet).Range("A8:J" & bas).Copy

Selection.Copy
Sheets("RECHERCHE").Range("A" & lig).PasteSpecial


End If
End If

Next
Application.CutCopyMode = False
End Sub

Pensez-vous que cela fonctionne ?

 

[youky(BJ)]

Re,
Il faut éviter les select aussi les cellules fusionnées.
Voici une nouvelle macro documentée.
Bruno

Sub essairech()
dim onglet,bas,lig
For onglet = 1 To Sheets.Count'boucle sur tous les onglets
If Left(Sheets(onglet).Name, 6) = "Chimie" Then 'si les 6 1ere lettre
bas = Sheets(onglet).[A65000].End(3).Row 'derligne
If bas > 7 Then
lig = Sheets("RECHERCHE").[A65000].End(3).Row + 1 'derligne+1 pour écrire
If lig < 3 Then lig = 3
Sheets("RECHERCHE").Cells(lig,1)=Sheets(onglet).Range("G3")'on écrit direct
Sheets(onglet).Range("A8:J" & bas).Copy 'on fait un copié
Sheets("RECHERCHE").Range("A" & lig+1).PasteSpecial 'on colle une ligne plus bas
End If
End If
Next
Application.CutCopyMode = False
End Sub

 

[L_Wa]

@youky(BJ) merci beaucoup pour le temps et les précisions. Cela fonctionne

A bientôt

Louis