Aide pour un macro

[bataggone]

bonjour tout le monde


je cherche un macro qui me permet de regrouper le contenu de plusieurs feuil dans une seul feuil.

bataggone

merci

 

[phlaurent55]

Re : Aide pour un macro

Bonjour bataggone,

juste pour te dire que les cellules fusionnées sont toujours source de problèmes
............ à éviter au maximum

à+
Philippe

 

[bataggone]

Re : Aide pour un macro

merci philippe
mais cette tableau est obligatoire pour tout le personnel...
il y a pas de solution ?????

 

[phlaurent55]

Re : Aide pour un macro

Re,

ton fichier en retour
.... mais ne demandes pas de regrouper les colonnes F ---> K si les cellules sont fusionnées 😡😡😡

à+
Philippe

 

[bataggone]

Re : Aide pour un macro

Re
Et merci Philippe
J'ai pas que quatre (4) feuil j'ai plus de 100 feuil..

 

[phlaurent55]

Re : Aide pour un macro

Re,

J'ai pas que quatre (4) feuil j'ai plus de 100 feuil..

il te faudra modifier

For i = 2 To 5

comme ceci:

For i = 2 To nombre_de_feuilles

la Feuille "GLOBALE" devant être la première.

si ce n'est pas le cas, remplace le code par celui-ci:

Sub Macro1()
Sheets("GLOBALE").Select
Application.ScreenUpdating = False
    Range("B6:E" & Range("B65535").End(xlUp).Row + 1).ClearContents

For i = 1 To 150    ' le_nombre_exact_de_feuilles
If Sheets(i).Name <>"GLOBALE" Then
    Sheets(i).Select
    Range("B8:B" & Range("B65535").End(xlUp).Row).Select
    Selection.Copy
    Sheets("GLOBALE").Select
    Range("B" & Range("B65535").End(xlUp).Row + 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets(i).Select
    Range("E8:E" & Range("B65535").End(xlUp).Row).Select
    Selection.Copy
    Sheets("GLOBALE").Select
    Range("E" & Range("E65535").End(xlUp).Row + 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Next i
End If
[C2].Select
Application.ScreenUpdating = True
End Sub

à+
Philippe

 

[bataggone]

Re : Aide pour un macro

Re bonjour Mr Philippe
désoler ça marche pas avec moi ..

 

[phlaurent55]

Re : Aide pour un macro

Re,

une petite inversion dans les dernières lignes et ça marche .........je l'espère

Sub Macro1()
Sheets("GLOBALE").Select
Application.ScreenUpdating = False
    Range("B6:E" & Range("B65535").End(xlUp).Row + 1).ClearContents

For i = 1 To 150    ' le_nombre_exact_de_feuilles
If Sheets(i).Name <> "GLOBALE" Then
    Sheets(i).Select
    Range("B8:B" & Range("B65535").End(xlUp).Row).Select
    Selection.Copy
    Sheets("GLOBALE").Select
    Range("B" & Range("B65535").End(xlUp).Row + 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets(i).Select
    Range("E8:E" & Range("B65535").End(xlUp).Row).Select
    Selection.Copy
    Sheets("GLOBALE").Select
    Range("E" & Range("E65535").End(xlUp).Row + 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End If
Next i
[C2].Select
Application.ScreenUpdating = True
End Sub

à+
Philippe

 

[bataggone]

Re : Aide pour un macro

Re
erreur d'exécution '9'

 

[phlaurent55]

Re : Aide pour un macro

Re,

cette erreur est provoquée par le fait que le nombre exact de feuilles n'est pas correct dans la première ligne ci-dessous

For i = 1 To 150    ' le_nombre_exact_de_feuilles
If Sheets(i).Name <> "GLOBALE" Then

et la ligne If Sheets(................ est surlignée en jaune

pour y remédier, il faut remplacer 150 par le nombre de feuilles que contient le classeur

ou plus simplement remplacer
For i = 1 To 150

par
For i = 1 To Sheets.Count
ce qui aura pour effet de ne plus devoir se soucier du nombre de feuilles


à+
Philippe