Coller colonnes depuis autres feuilles

Bonjour à tous !

Joyeux Noël à ceux qui le fête

J'aurais besoin de vous pour une petite problèmatique. J'ai un fichier avec 19 feuilles qui contiennent chacune exactement 100 lignes de résultats de NBA. Les lignes sont chacunes numérotées. À savoir, sur la première feuille il y aura les lignes 1 à 100, sur la 2ème 101 à 200 etc..

J'aimerai mettre toutes ces lignes dans l'ordre croissant dans une nouvelle feuille.

J'ai fait l'exemple à la main dans le fichier joint. La feuille "But" est le résultat que je veux obtenir.

Merci d'avance pour votre aide et bonne journée

Quik

Bonjour toutes et tous

merci à Eric sur un forum

Sub CopierLesDonneesDansBut()

Dim ShSynthese As Worksheet
Dim Sh As Worksheet
Dim ShEnCours As Worksheet

Dim AireACopier As Range

Dim LigneDeTitreSynthese As Long
Dim DerniereLigneSynthese As Long
Dim PremiereColonneSynthese As Long
Dim LigneDebutSynthese As Long

    Application.ScreenUpdating = False

    Set ShSynthese = Sheets("But")
    LigneDeTitreSynthese = 10
    PremiereColonneSynthese = 1

    ' Effacement de la feuille synthèse/But
    ShSynthese.Range(ShSynthese.Cells(LigneDeTitreSynthese + 1, 1), ShSynthese.Cells(ShSynthese.Rows.Count, ShSynthese.Columns.Count)).ClearContents
    DerniereLigneSynthese = ShSynthese.Cells(ShSynthese.Rows.Count, PremiereColonneSynthese).End(xlUp).Row

    For Each Sh In Worksheets

        If Sh.Name <> "But" Then
           Set ShEnCours = Sheets(Sh.Name)

           Set AireACopier = ShEnCours.Range("a1:k100")

           With ShSynthese
                LigneDebutSynthese = DerniereLigneSynthese
                AireACopier.Copy
                .Cells(DerniereLigneSynthese + 1, PremiereColonneSynthese).Select
                ShSynthese.Paste
                DerniereLigneSynthese = ShSynthese.Cells(ShSynthese.Rows.Count, PremiereColonneSynthese).End(xlUp).Row
           End With

           Set AireACopier = Nothing
           Set ShEnCours = Nothing

       End If

    Next Sh

    ShSynthese.Cells(LigneDeTitreSynthese, 1).Activate
    Set ShSynthese = Nothing
    Application.ScreenUpdating = True

End Sub

testé sa fonctionne

crdlt,

André

Salut quik,

je te répondrais bien pourquoi faire puisque tu l'as fait toi-même mais j'imagine que ce sera un traitement hebdomadaire .

Premier jet, donc :

• le code scanne les feuilles présentes et crée, si nécessaire, une feuille récapitulative "NBA" qu'il place en n°1 ;
• 'NBA' est nettoyée ;
• 2e boucle : les données sont copiées selon le n° de ligne renseigné sur chaque feuille.

Si tel ne devait pas être le cas à l'avenir, une modif' serait nécessaire!

La macro démarre sur un double-clic n'importe où sur n'importe quelle feuille.

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
'
Cancel = True
Application.ScreenUpdating = False
'
For x = 1 To 2
    iOK = 0
    For y = IIf(x = 1, 1, 2) To Sheets.Count
        If x = 1 And Sheets(y).Name = "NBA" Then iOK = 1: Exit For
        If x = 2 Then
            tData = Sheets(y).Range("A1:J100").Value
            Sheets(1).Range("A" & CInt(tData(1, 1))).Resize(100, 10).Value = tData
        End If
    Next
    If x = 1 Then
        If iOK = 0 Then Sheets.Add(before:=Sheets(1)).Name = "NBA"
        If iOK = 1 And y <> 1 Then Sheets(y).Move before:=Sheets(1)
        Sheets(1).Cells.Delete
    End If
Next
Sheets(1).Activate
'
Application.ScreenUpdating = True
'
End Sub

Joyeuses Fêtes!

A+

Salut André13 : on s'est croisés! Joyeux Noël!

Merci également Curulis,

je vais essayé de voir ton code car, j'ai encore trop de lacune sur ce sujet

merci à toi

Bonjour

Par formule

En a1

=SI(INDIRECT("Feuil"&ENT((LIGNE()-1)/100)+2&"!L"&LIGNE()-(100*ENT((LIGNE()-1)/100))&"C"&COLONNE();0)="";"";INDIRECT("Feuil"&ENT((LIGNE()-1)/100)+2&"!L"&LIGNE()-(100*ENT((LIGNE()-1)/100))&"C"&COLONNE();0))

A recopier de la ligne 1 à 1900 et de la colonne A à J

Bonjour Andre, Curulis et Chris !

Merci beaucoup à vous trois!!

Trois solutions qui fonctionnent parfaitement pour le prix d'une !

Passez de belles fêtes

Quik