Discussion :

[meedoo2]

Bonjour d'un nouvel abonné,
J'ai 47 feuilles dans mon classeur. Dans chaque feuille, je voudrais copier les données (en valeurs et non pas formule) de la range C40:N40 vers une nouvelle feuille (la 48 ème).
ça va me donner (sur cette dernière feuille) un nouveau tableau de 47 lignes et 12 colonnes.
S'il y a une Macro pour cela, Merci de bien vouloir la patager.
Bien cordialement.

[BENNASR]

Bonsoir cousin
créez un nouvel onglet nommé ("RECAP") et essayez avec

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub test()
Application.ScreenUpdating = False
Dim derligne As Long
Dim j As Long
j = 1
With Sheets("RECAP")
 For i = 1 To Worksheets.Count
        If Worksheets(i).Name <> "RECAP" Then
            Worksheets(i).Range("C40:N40").Copy
            Range("A" & j).PasteSpecial Paste:=xlPasteValues
            Application.CutCopyMode = False
        End If
        j = j + 1
    Next i
End With
MsgBox ("Regroupement effectué avec succès .... ")
Application.ScreenUpdating = True
End Sub

[meedoo2]

Bonjour Cousin et bien merci pour la réponse rapide.
Le résultat est Nickel et le tableau souhaitée s'affiche bien; mais une petite fenêtre de message s'affiche dessus indiquant : "Regroupement effectué avec succès..". Cette fenêtre ne veut pas disparaître, que je clique Ok ou sur la croix, elle revient aussitôt et empêche tout autre chose. Excel ne peut plus bouger sans faire disparaître cette fenêtre. Je suis obligé d’arrêter la tache via le gestionnaire de tache pour avoir de nouveau la main. Comment alors remédier à ce problème et merci encore une fois.

[BENNASR]

bonjour
il suffit de supprimer ce message (Ligne 16)
Voila le code sans ce message :
Merci de cliquer sur RESOLU en bas si c'est le cas

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub test()
Application.ScreenUpdating = False
Dim derligne As Long
Dim j As Long
j = 1
With Sheets("RECAP")
 For i = 1 To Worksheets.Count
        If Worksheets(i).Name <> "RECAP" Then
            Worksheets(i).Range("C40:N40").Copy
            Range("A" & j).PasteSpecial Paste:=xlPasteValues
            Application.CutCopyMode = False
        End If
        j = j + 1
    Next i
End With
Application.ScreenUpdating = True
End Sub