Microsoft 365 Coller dans un onglet des éléments d'autres onglets

[lucarn]

Bonjour,
Je suis débutant.
Je cherche à coller dans un onglet des éléments (toujours les mêmes cellules) dans un seul onglet.

En lien un exemple sachant qu'il peut y avoir plus d'une centaine d'onglets.
Il s'agit donc de coller les éléments situés entre la colonne 8 et la colonne 14 et entre la 1ère ligne et la 2ème.

Merci d'avance

 

[Staple1600]

Bonjour le fil, lucarn

•>lucarn
Si j'ai compris la donne
(une solution avec une petite macro)

Sub m8et14()
Dim ws As Worksheet
For Each ws In Worksheets
If Not ws.Name Like "RESULTAT" Then
ws.Range(ws.Cells(1, "H"), ws.Cells(Rows.Count, "H").End(3)).Resize(, 7).Copy Sheets("RESULTAT").Cells(Rows.Count, 1).End(3)(3)
Application.CutCopyMode = False
End If
Next
Sheets("RESULTAT").Rows("1:2").EntireRow.Delete
Sheets("RESULTAT").UsedRange.Columns.AutoFit
End Sub

EDITION: Bonjour job75

 

[job75]

Bonjour lucarn, JM,

Ou aussi :

Sub Copier()
Dim lig&, w As Worksheet
lig = 1
Application.ScreenUpdating = False
With Sheets("RESULTAT")
    .Cells.Clear 'RAZ
    For Each w In Worksheets
        If w.Name <> .Name Then
            w.Range("H1:N2").Copy .Cells(lig, 1)
            lig = lig + 3
        End If
    Next
    .Columns.AutoFit 'ajustement largeur
    .Activate 'facultatif
End With
End Sub

A+

 

[lucarn]

Bonjour lucarn, JM,

Ou aussi :

Sub Copier()
Dim lig&, w As Worksheet
lig = 1
Application.ScreenUpdating = False
With Sheets("RESULTAT")
    .Cells.Clear 'RAZ
    For Each w In Worksheets
        If w.Name <> .Name Then
            w.Range("H1:N2").Copy .Cells(lig, 1)
            lig = lig + 3
        End If
    Next
    .Columns.AutoFit 'ajustement largeur
    .Activate 'facultatif
End With
End Sub

A+

Salut Job,
Merci pour ton coup de main.
Seulement voilà. Lorsque j'essaye d'adapter ta macro au doc sur lequel je travaille, cela fait tout autre chose que dans ta version.
Je te mets mon doc.
J'ai changé le mot RESULTAT par celui de RAPPORTS
Puis les H1 et N2 par O1 et U8
Et ça me fait du grand n'importe quoi.

Petite précision, tu n'a pas collé les valeurs mais les fonctions et pour ce qui est de l'ajustement de la largeur, je préfère qu'elle reste identique.
Je serai curieux de voir ta nouvelle macro que je comprenne mon erreur

 

[Staple1600]

Re

•>lucarn
Euh?
Sympathique, lucarn
Le message#2 n'est pas considéré comme un coup de main
Ca donne envie d'aider son prochain, tiens !

 

[lucarn]

Re

•>lucarn
Euh?
Sympathique, lucarn
Le message#2 n'est pas considéré comme un coup de main
Ca donne envie d'aider son prochain, tiens !

Bonjour Staple,
Tu m'as pris de vitesse. Je me prends la tête avec vos deux macros et effectivement, emporté dans mon élan, je suis passé de ta macro à la suivante.
1000 excuses et merci pour ton aide. Je ne t'ai pas oublié intentionnellement.
J'ai essayé d'adapter aussi ta macro sans succès avec des résultats abradacabrandesques comme dirait l'autre.
Si tu veux bien regarder le doc que j'ai envoyé et adapter ta macro parce que, décidément, je ne parviens pas à comprendre pourquoi l'adaptation ne donne absolument pas le même résultat.
Merci encore.

 

[job75]

Ma nouvelle macro pour le nouveau fichier :

Sub Copier()
Dim adr$, lig&, decal&, w As Worksheet, mem
adr = "O1:U8" 'adresse à adapter
lig = 1 '1ère ligne de destination, à adapter
Application.ScreenUpdating = False
With Sheets("RAPPORTS")
    decal = .Range(adr).Rows.Count + 1 '1 ligne de séparation
    .Rows(lig & ":" & .Rows.Count).Clear 'RAZ
    For Each w In Worksheets
        If UCase(w.Name) Like "F#*" Then
            mem = w.Range(adr).Formula 'mémorise les formules
            w.Range(adr) = w.Range(adr).Value 'supprime les formules
            w.Range(adr).Copy .Cells(lig, 1) 'copier-coller
            w.Range(adr) = mem 'restitution
            lig = lig + decal
        End If
    Next
    .Activate 'facultatif
End With
End Sub

 

[Staple1600]

Re

Merci lucarn pour le retour
J'étais prêt à sortir mon attestation dérogatoire pour aller chercher un paquet de mouchoir en papier pour sécher mes larmes
Et puisque job75 a entre-temps ouvert ton nouveau fichier, sa macro devrait répondre à tes questions.

 

[lucarn]

Re

Merci lucarn pour le retour
J'étais prêt à sortir mon attestation dérogatoire pour aller chercher un paquet de mouchoir en papier pour sécher mes larmes
Et puisque job75 a entre-temps ouvert ton nouveau fichier, sa macro devrait répondre à tes questions.

Cette fois, je te réponds avant de remercier Stapple vu que les boutiques de mouchoirs sont fermées.
Je suppose que si tu adaptais ta macro, il y aurait de grandes différences d'avec la première comme pour celle de Stapple.
Question bête : c'est un boulot d'ingénieur ce que vous faites ?
Merci encore. J'aurai d'autres questions.... A bientôt

 

[lucarn]

Cette fois, je te réponds avant de remercier Stapple vu que les boutiques de mouchoirs sont fermées.
Je suppose que si tu adaptais ta macro, il y aurait de grandes différences d'avec la première comme pour celle de Stapple.
Question bête : c'est un boulot d'ingénieur ce que vous faites ?
Merci encore. J'aurai d'autres questions.... A bientôt

M.... je me suis trompé dans les noms. Décidément !!! Y'a pas qu'avec les macros que je n'assure pas ! Salut Stapple

 

[lucarn]

Ma nouvelle macro pour le nouveau fichier :

Sub Copier()
Dim adr$, lig&, decal&, w As Worksheet, mem
adr = "O1:U8" 'adresse à adapter
lig = 1 '1ère ligne de destination, à adapter
Application.ScreenUpdating = False
With Sheets("RAPPORTS")
    decal = .Range(adr).Rows.Count + 1 '1 ligne de séparation
    .Rows(lig & ":" & .Rows.Count).Clear 'RAZ
    For Each w In Worksheets
        If UCase(w.Name) Like "F#*" Then
            mem = w.Range(adr).Formula 'mémorise les formules
            w.Range(adr) = w.Range(adr).Value 'supprime les formules
            w.Range(adr).Copy .Cells(lig, 1) 'copier-coller
            w.Range(adr) = mem 'restitution
            lig = lig + decal
        End If
    Next
    .Activate 'facultatif
End With
End Sub

Super, ça marche impeccable.
Mais quand je vois tout ce que tu as bougé, je ne risquais effectivement pas d'y parvenir.
A la prochaine

 

[Staple1600]

Re

Pour ce qui me concerne, je suis captif dans une sorte de goulag en DMZ.
et depuis plus de quinze on m'oblige à faire des choses avec Excel et a les poster ici.
(heureusement la chair et bonne, et la bière fraiche, seul souci, je n'ai pas vu le soleil depuis longtemps)
Tout cela parce un jour, j'ai acheté un modem 56K...C'est là que le cauchemar a vraiment commencé

PS1: Sérieusement, non je suis juste quelqu'un qui triture Excel depuis 1991.
PS2: C'est Staple avec un seul p