XL 2010 Rassembler que certains onglets par macro

karotte · 20 Février 2020

Bonjour le fil,

Je viens vous solliciter pour la modification d'une macro : J'aimerais tout simplement inclure que certains onglets "service 1" service 2" "service 3" "service 4"... et non pas tout le classeur Excel.

Sub consolide_onglets()
Sheets("base").[A1].CurrentRegion.Offset(1, 0).Clear
For s = 2 To Sheets.Count
Range(Sheets(s).[A2], Sheets(s).[A65000].End(xlUp).End(xlToRight)).Copy _
[A65000].End(xlUp).Offset(1, 0)
Next s
On Error Resume Next
[A:A].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

ps : pourriez vous également m'expliquer chacune de ses etapes? merci d'avance

Thanks d'avance

ERIC S · 20 Février 2020

Bonjour

évite de multiplier les fils, j'ai répondu sur le fil "consolider des onglets..."
donc dans ta boucle for next, tu introduits un test sur le nom de l'onglet
For ....
if sheets(s).name="service 1" or sheets(s).name= ... then
.....
endif
Next...

karotte · 20 Février 2020

ERIC S à dit:
nc dans ta boucle for next, tu introduits un

ERIC S à dit:
Bonjour

évite de multiplier les fils, j'ai répondu sur le fil "consolider des onglets..."
donc dans ta boucle for next, tu introduits un test sur le nom de l'onglet
For ....
if sheets(s).name="service 1" or sheets(s).name= ... then
.....
endif
Next...

Désolée, je ne pensais pas que quelqu'un allait me répondre sur le poste de 2012...

Du coup, peux tu me dire où est ce que je dois modifier les données pour pouvoir par exemple sélectionner l'emplacement de mon tableau ?

Merci d'avance ERIC

Karotte

ERIC S · 20 Février 2020

Re
cela dépend de ce que tu veux faire exactement, as-tu un exemple de fichier ?

karotte · 20 Février 2020

ERIC S à dit:
Re
cela dépend de ce que tu veux faire exactement, as-tu un exemple de fichier ?

Re Eric

Je pense que j'ai mal expliqué la chose.
Je me demandais où spécifier la plage de données des onglets à consolider.
j'imagine que c'est à cette étape non ?
Range(Sheets(s).[A2], Sheets(s).[A65000].End(xlUp).End(xlToRight)).Copy _
[A65000].End(xlUp).Offset(1, 0)

ERIC S · 20 Février 2020

re

Sub consolide_onglets()
'efface tes enregistrements sur ta feuille de consolidation (1ère feuille) sauf ligne 1 (intitulés sans doute
Sheets("base").[A1].CurrentRegion.Offset(1, 0).Clear
'balaie les feuilles à partir de la feuille 2
For s = 2 To Sheets.Count
'selectionne les feuilles
if sheets(s).name ........ then
'copie zone de données remplies à partir de A2 de chaque feuille balayée sur la feuille de consolidation, à la suite des copies précédentes, donc commence en ligne 2 après l'effacement puis si par exemple tu as copié 10 enregistrements ils sont en tre 2 et 11, pour la feuille d'après, copiera en 12 et suivantes
Range(Sheets(s).[A2], Sheets(s).[A65000].End(xlUp).End(xlToRight)).Copy _
[A65000].End(xlUp).Offset(1, 0)
end if
Next s
On Error Resume Next
'supprime les éventuelles lignes vides je pense, non testé
[A:A].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

karotte · 20 Février 2020

ERIC S à dit:
'copie zone de données remplies à partir de A2 de chaque feuille balayée sur la feuille de consolidation, à la suite des copies précédentes, donc commence en ligne 2 après l'effacement puis si par exemple tu as copié 10 enregistrements ils sont en tre 2 et 11, pour la feuille d'après, copiera en 12 et suivantes
Range(Sheets(s).[A2], Sheets(s).[A65000].End(xlUp).End(xlToRight)).Copy _
[A65000].End(xlUp).Offset(1, 0)

Merci énormément pour toutes tes explications Eric !

Par contre pour cette partie je ne comprends pas le sens de la manipulation. Pour faire simple, j'aimerais simplement consolider les plages de données [A13;AL600] de chaque onglet

Merci d'avance Eric, je vois bientot le bout du tunnel. Croisons les doigts

ERIC S · 20 Février 2020

RE
en absence de fichier, tu peux essayer le code suivant
copie la zone A13:AL600 dans la feuille nommée Base (il faut adapter au nom de ta feuille de consolidation).
je démarre la boucle for en 1 comme cela on balaie toutes tes feuilles et la feuille de consolidation peut être n'importe où, il suffit de ne pas la mettre au niveau du if...

VB:

Sub consolide_onglets()
Sheets("base").[A1].CurrentRegion.Offset(1, 0).Clear
For s = 1 To Sheets.Count
if sheets(s).name="service 1" or sheets(s).name="service 2" then
Range(Sheets(s).[A13], [AL600]).Copy _
[A65000].End(xlUp).Offset(1, 0)
end if
Next s
On Error Resume Next
[A:A].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

karotte · 20 Février 2020

ERIC S à dit:
RE
en absence de fichier, tu peux essayer le code suivant
copie la zone A13:AL600 dans la feuille nommée Base (il faut adapter au nom de ta feuille de consolidation).
je démarre la boucle for en 1 comme cela on balaie toutes tes feuilles et la feuille de consolidation peut être n'importe où, il suffit de ne pas la mettre au niveau du if...

VB:

Sub consolide_onglets() Sheets("base").[A1].CurrentRegion.Offset(1, 0).Clear For s = 1 To Sheets.Count if sheets(s).name="service 1" or sheets(s).name="service 2" then Range(Sheets(s).[A13], [AL600]).Copy _ [A65000].End(xlUp).Offset(1, 0) end if Next s On Error Resume Next [A:A].SpecialCells(xlCellTypeBlanks).EntireRow.Delete End Sub

Il y a une erreur d'exécution '424', un débogage sur :
Range(Sheets(s).[A13], [AL600]).Copy _
[A65000].End(xlUp).Offset(1, 0)

ERIC S · 20 Février 2020

re
désolé une erreur il manquait sheets(s). devant [AL600]
Cà arrive quand on n'a pas de fichier

VB:

Sub consolide_onglets()
Sheets("base").[A1].CurrentRegion.Offset(1, 0).Clear
For s = 1 To Sheets.Count
If Sheets(s).Name = "service 1" Or Sheets(s).Name = "service 2" Then
Range(Sheets(s).[A13], Sheets(s).[AL600]).Copy Destination:=[A65000].End(xlUp).Offset(1, 0)
End If
Next s
On Error Resume Next
[A:A].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

Staple1600 · 20 Février 2020

Bonsoir le fil

karotte
1) L'usage c'est de continuer dans le fil initial

https://www.excel-downloads.com/thr...onglets-via-une-macro.20041635/#post-20299840

(pour éviter les doublons)
2) Et accessoirement avoir la courtoisie d'indiquer que tu as déjà reçu de l'aide dans le premier fil est appréciable...
[ironie du jeudi soir]
Il est connu que la consommation de carotte rend aimable.
Mais être aimable n'implique pas forcément d'être courtois
[/ironie du jeudi soir]

karotte · 21 Février 2020

Staple1600 à dit:
Bonsoir le fil

karotte
1) L'usage c'est de continuer dans le fil initial

https://www.excel-downloads.com/thr...onglets-via-une-macro.20041635/#post-20299840
(pour éviter les doublons)
2) Et accessoirement avoir la courtoisie d'indiquer que tu as déjà reçu de l'aide dans le premier fil est appréciable...
[ironie du jeudi soir]
Il est connu que la consommation de carotte rend aimable.
Mais être aimable n'implique pas forcément d'être courtois
[/ironie du jeudi soir]

Je note tout ça pour la suite alors!

karotte · 21 Février 2020

ERIC S à dit:

re
désolé une erreur il manquait sheets(s). devant [AL600]
Cà arrive quand on n'a pas de fichier

VB:

Sub consolide_onglets()
Sheets("base").[A1].CurrentRegion.Offset(1, 0).Clear
For s = 1 To Sheets.Count
If Sheets(s).Name = "service 1" Or Sheets(s).Name = "service 2" Then
Range(Sheets(s).[A13], Sheets(s).[AL600]).Copy Destination:=[A65000].End(xlUp).Offset(1, 0)
End If
Next s
On Error Resume Next
[A:A].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

Merci Eric ça marche c'est top !

Dernière petite sollicitation, peux tu me dire à quoi correspond la partie en rouge et en gras ?
Range(Sheets(s).[A2], Sheets(s).[A65000].End(xlUp).End(xlToRight)).Copy _
[A65000].End(xlUp).Offset(1, 0)

Un grand merci à tous! Merci Staple 1600, merci Eric

karotte · 24 Février 2020

Bonjour la communauté,

j'ai une dernière petite sollicitation. J'aimerais lors des concaténation créer une colonne qui reprend le nom de mes onglets. Comment faire?

Un grand merci à vous tous

Staple1600 · 24 Février 2020

Bonsoir le fil

VB:

Sub consolider_onglets_a_ma_sauce()
Dim ws As Worksheet, dl&
For Each ws In Worksheets
If InStr("1234", Right(ws.Name, 1)) > 0 Then
  dl = ws.Cells(Rows.Count, 1).End(3).Row
    With Sheets("base").Cells(Rows.Count, 1).End(3)(2).Resize(dl)
      .Value = ws.Name
      .Offset(, 1).Value = ws.Cells(1).Resize(dl).Value
    End With
End If
Next
End Sub

Test OK sur mon fichier exemple.

XL 2010 Rassembler que certains onglets par macro

karotte

XLDnaute Nouveau

ERIC S

XLDnaute Barbatruc

karotte

XLDnaute Nouveau

ERIC S

XLDnaute Barbatruc

karotte

XLDnaute Nouveau

ERIC S

XLDnaute Barbatruc

karotte

XLDnaute Nouveau

ERIC S

XLDnaute Barbatruc

karotte

XLDnaute Nouveau

ERIC S

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

karotte

XLDnaute Nouveau

karotte

XLDnaute Nouveau

karotte

XLDnaute Nouveau

Staple1600

XLDnaute Barbatruc

Discussions similaires