Regroupement d'onglets à partir d'une position variable

Question

J'ai bien trouvé des indication sur une macro permettant de regrouper des onglet d'un meme fichier excel sur un nouvel onglet global mais mon besoin est je pense plus complex. En effet, même si la zone a recopier sur chaque onglet est identique (en nombre de colonnes), la cellule à partir de laquelle elle démarre varie suivant les onglets. Je vous place en PJ l'exemple concret de ce que je tente de faire. Mais un exemple plus simple : j'ai deux onglets. sur onglet 1 je veux récupérer le tableau qui va de A2 à C5 alors que sur l'onglet 2, ce meme tableau va de B5 à D10. Le tout sera regroupé sur un nouvel onglet automatiquement par macro ou on retrouvera ce tableau qui a donc 3 colonnes avec les lignes de l'onglet 1 puis directement à la suite les lignes de l'onglet deux. Pour savoir ou faire partir la copie du tableau sur chaque onglet je pensais à une msgbox qui demanderait à quelle cellule démarrer qu'en pensez vous ? Je précise que le tableau à toujours le meme nombre de colonne (17 colonnes cf ma PJ) mais le nombre de ligne est variable. De même le nombre d'onglet sur la feuille est variable, le nom des onglets peu être le même ou varier aussi. merci pour votre aide...

Ausecour · Answer

Bonjour, je vois bien que tu as des décalages sur ton fichier, ce qui est un gros souci en VBA, et peut poser un souci si tu dois à chaque feuille préciser quelle cellule est celle en haut à gauche de ton tableau, c'est pas optimal et on est pas à l'abri d'un clic à côté qui fait tout planter...

Est-ce qu'on peut partir du principe que: ton en-tête "N° CTN" se trouve toujours dans une zone et que ton en-tête bouge dans cette zone?

Sur ton exemple, ton tableau se décale d'une colonne entre la feuille 1 et la feuille 2, est-ce qu'il lui arrive vraiment de terminer perdu en colonne CH par exemple? ou bien est-ce qu'il se décale de moins de 10 colonnes à chaque fois? voir 5? parce qu'après je peux facilement te faire une macro de recherche qui va trouver cette en-tête pour trouver la position du tableau, qu'en penses-tu?

Parce que si à chaque fois tu dois renseigner la cellule de départ, tu irais presque plus vite en copiant collant toi même chaque infos de chaque feuille à la main...

h2so4 · Answer

Une proposition via macro edit: bonjour ausecour Sub aargh() With Sheets("regroupement des onglets") dl = .Cells(Rows.Count, 1).End(xlUp).Row .Range("A2").Resize(dl, 18).Clear k = 2 For Each ws In Worksheets If ws.Name &lt;&gt; .Name Then Set re = Nothing On Error Resume Next Set re = ws.UsedRange.Find("N° commande", lookat:=xlWhole, after:=ws.Range("A7"), searchorder:=xlByRows) On Error GoTo 0 If Not re Is Nothing Then dl = re.End(xlDown).Row re.Cells(2, 1).Resize(dl - re.Row, 18).Copy .Cells(k, 1) k = k + dl - re.Row End If End If Next ws End With End Sub...

h2so4 · Answer

Avec la creation de l'onglet, pour le reste cela devrait fonctionner à la condition que ton tableau commence toujours après la ligne 7 Sub aargh() Application.DisplayAlerts = False On Error Resume Next Sheets("regroupement des onglets").Delete On Error GoTo 0 Application.DisplayAlerts = True With Sheets.Add(after:=Sheets(1)) .Name = "regroupement des onglets" dl = .Cells(Rows.Count, 1).End(xlUp).Row k = 1 For Each ws In Worksheets If ws.Name &lt;&gt; .Name Then Set re = Nothing On Error Resume Next Set re = ws.UsedRange.Find("N° commande", lookat:=xlWhole, after:=ws.Range("A7"), searchorder:=xlByRows) On Error GoTo 0 If Not re Is Nothing Then dl = re.End(xlDown).Row If k = 1 Then re.Cells(1, 1).Resize(dl + 1 - re.Row, 18).Copy .Cells(k, 1) k = k + dl + 1 - re.Row Else re.Cells(2, 1).Resize(dl - re.Row, 18).Copy .Cells(k, 1) k = k + dl - re.Row End If End If End If Next ws Cells.EntireColumn.AutoFit End With End Sub...

Ausecour · Answer

Re,

pas de souci en vue pour ton code h2so4, juste une chose que je ne comprends pas bien...

Sheets("regroupement des onglets").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True

    With Sheets.Add(after:=Sheets(1))
        .Name = "regroupement des onglets"
        dl = .Cells(Rows.Count, 1).End(xlUp).Row
        .Range("A2").Resize(dl, 18).Clear

Tu supprimes la feuille de synthèse, tu en recrées une, et sur cette même feuille tu vas chercher la dernière ligne remplie pour supprimer des choses sur ta feuille vide? Je ne comprends pas très bien la logique de cette partie, une erreur de ta part ou bien une incompréhension de mon côté?

h2so4 · Answer

@ ausecour,

un résidu de la version précédente, qui aurait dû disparaître dans cette nouvelle version.

@benjy

as-tu essayé la macro proposée ou pars-tu du principe que cela ne fonctionne pas ?

Ausecour · Answer

Je ne proposerai pas de programme supplémentaire car la macro de h2so4 le fait déjà Il y a une partie du code qui cherche le début du tableau de la façon dont je t'avais parlé, je n'ai pas grand chose à ajouter à part la petite question que j'avais posé à h2so4, je te conseille de tester sa macro, elle fonctionne pile poil...

Ausecour · Answer

Re, le truc c'est que ça semble impossible, la ligne 7 et les quelques lignes qui suivent contiennent tes en-têtes, tu es sûr que ton tableau peut aller dessus? h2so4 fait exactement cette recherche de zone, après si VRAIMENT c'est nécessaire, elle peut-être légèrement modifiée, mais je ne vois pas le besoin d'effectuer ce changement pour le moment...

Ausecour · Answer

Re,

Ah je vois, le fournisseur peut faire n'importe quoi, dans ce cas, je propose en effet de modifier cette ligne par:

Set re = ws.UsedRange.Find("N° CTN", lookat:=xlWhole, searchorder:=xlByRows).Offset(0, -2)

Comme "N° CTN" n'apparait qu'une fois sur le fichier, plus besoin de se poser trop de questions par contre j'ai rajouté .offset(0, -2) pour ne pas boulverser la suite du programme

Ausecour · Answer

Ca marche, si tu valides tout, merci de passer le sujet en résolu...

h2so4 · Answer

Voici une adaptation Sub SUPPLY() Application.DisplayAlerts = False On Error Resume Next 'Sheets("regroupement des onglets").Delete On Error GoTo 0 Application.DisplayAlerts = True With Sheets.Add(after:=Sheets(1)) .Name = "regroupement des onglets" dl = .Cells(Rows.Count, 1).End(xlUp).Row k = 1 For Each ws In Worksheets If ws.Name &lt;&gt; .Name Then Set re = Nothing On Error Resume Next Set re = ws.UsedRange.Find("N° CTN", lookat:=xlWhole, searchorder:=xlByRows).Offset(0, -1) On Error GoTo 0 If Not re Is Nothing Then dl = re.Offset(1).End(xlDown).Row If k = 1 Then re.Cells(1, 1).Resize(dl + 1 - re.Row, 18).Copy .Cells(k, 1) k = k + dl + 1 - re.Row Else re.Cells(2, 1).Resize(dl - re.Row, 18).Copy .Cells(k, 1) k = k + dl - re.Row End If End If End If Next ws Cells.EntireColumn.AutoFit End With End Sub...