XL 2016 modification de code vba

[Seddiki_adz]

comment modifier ce code vba si je veut juste consolider des onglets définie par leur nom
Sub Consolider()
Dim lig As Long, w As Worksheet, h As Long
Feuil1.Activate 'CodeName de "Consolidation Synthèse"
Application.ScreenUpdating = False 'fige l'écran
Rows("5:" & Rows.Count).Delete 'vidage
lig = 5 '1ère ligne à remplir
For Each w In Worksheets
If w.Name <> ActiveSheet.Name Then
h = w.Cells(Rows.Count, 2).End(xlUp).Row - 4
If h > 0 Then
w.[5:5].Resize(h).Copy Cells(lig, 1)
lig = lig + h
End If
End If
Next
If lig = 5 Then Exit Sub 'si aucun nom
With [5:5].Resize(lig - 5)
.Sort [B5], Header:=xlNo 'tri sur colonne B
'---épuration---
.Columns(2).Replace " ", "", LookAt:=xlWhole
On Error Resume Next
.Columns(2).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub

Merci

 

[cp4]

Bonjour,

Sans fichier difficile de t'aider. Voici un lien où tu trouveras surement ton bonheur LIEN
Démo pour éditer ton code afin qu'il soit mieux lisible


A+

 

[Seddiki_adz]

Bonjour,

Sans fichier difficile de t'aider. Voici un lien où tu trouveras surement ton bonheur LIEN
Démo pour éditer ton code afin qu'il soit mieux lisible
Regarde la pièce jointe 1135493

A+

Merci
ce code vba

 

[cp4]

Merci
ce code vba

Je n'ai rien compris. Ni fichier, ni explications, je ne suis pas devin.

 

[Seddiki_adz]

Je n'ai rien compris. Ni fichier, ni explications, je ne suis pas devin.

ce code vba consolider toutes les onglets et je modifier pour 3 onglet

consolidation données issues de plusieurs feuilles dans une seule.... (INDIRECT, etc

j'ai réalisé une maquette pour suivre les effectifs de plusieurs région... chaque maquette est composée de 6 onglets (dont une synthèse sur laquelle est compilée l'ensemble des données dont j'ai besoin) les structures sont rigouresement les même pour chacune des maquettes. j'ai créé une...

www.excel-downloads.com

 

[cp4]

ce code vba consolider toutes les onglets et je modifier pour 3 onglet

consolidation données issues de plusieurs feuilles dans une seule.... (INDIRECT, etc

j'ai réalisé une maquette pour suivre les effectifs de plusieurs région... chaque maquette est composée de 6 onglets (dont une synthèse sur laquelle est compilée l'ensemble des données dont j'ai besoin) les structures sont rigouresement les même pour chacune des maquettes. j'ai créé une...

www.excel-downloads.com

Ce n'est pas en me montrant des exemples que je vais comprendre ta problématique.
Il faut joindre ton fichier et des explications ou mieux le résultat attendu du code.
En effet, sur le fichier joint le code boucle sur toute les feuilles sauf la feuille active.

A+

 

[Seddiki_adz]

Ce n'est pas en me montrant des exemples que je vais comprendre ta problématique.
Il faut joindre ton fichier et des explications ou mieux le résultat attendu du code.
En effet, sur le fichier joint le code boucle sur toute les feuilles sauf la feuille active.

A+

j'ai ajouter un onglet dans ce fichier et je ne veut pas consolider avec les autre onglets

 

[cp4]

j'ai ajouter un onglet dans ce fichier et je ne veut pas consolider avec les autre onglets

à tester, je n'ai rajouté qu'une condition pour ne pas prendre en compte aussi la feuille que tu as ajouté (feuil1)

Option Explicit

Sub Consolider()
Dim lig As Long, w As Worksheet, h As Long
Feuil1.Activate 'CodeName de "Consolidation Synthèse"
Application.ScreenUpdating = False 'fige l'écran
Application.DisplayAlerts = False 'évite les invites éventuelles (liaisons)
Rows("5:" & Rows.Count).Delete 'vidage
lig = 5 '1ère ligne à remplir
For Each w In Worksheets
  If w.Name <> ActiveSheet.Name And w.Name <> "feuil1" Then ' ajout condition non feuil1
    h = w.Cells(Rows.Count, 1).End(xlUp).Row - 4
    If h > 0 Then
      w.[5:5].Resize(h).Copy Rows(lig) 'pour les formats
      Rows(lig).Resize(h, 13) = w.[5:5].Resize(h, 13).Value 'valeurs colonnes A:M
      lig = lig + h
    End If
  End If
Next
If lig = 5 Then Exit Sub 'si aucun nom
With [5:5].Resize(lig - 5)
  .Sort [B5], Header:=xlNo 'tri sur colonne B
  '---épuration---
  .Columns(1).Replace " ", "", LookAt:=xlWhole
  On Error Resume Next
  .Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub