Microsoft 365 Compil de tableaux vers la droite

momo · 15 Mars 2023

Bonjour à tous

Je voudrais réaliser une compil de tableaux vers la droite
Le but serait d'identifier les dernières cellules non vides de la plage A à H de l'onglet "Test" et d'aller coller à chaque fois dans l'onglet "Résultats attendu" vers la droite à chaque fois . Autrement dit identifier la dernière colonne vide et coller chaque plage
Je joins un fichier illustratif
Je vous remercie d'avance

AtTheOne · 15 Mars 2023

Bonjour à toutes & à tous,
bonjour @momo
J'y vais de ma solution :

VB:

Sub Bas_Vers_Droite()

     Const col_déb = 1, lgn_déb = 1
     Dim Sh As Worksheet, Sh_r As Worksheet, rg As Range, derCol As Integer
     Set Sh = ThisWorkbook.Worksheets("Test")
    
     ThisWorkbook.Worksheets.Add after:=Sh
     Set Sh_r = ActiveSheet
    
     continuer = True
     Set rg = Sh.Cells(lgn_déb, col_déb).CurrentRegion
     While continuer
          derCol = Sh_r.Cells(lgn_déb, Sh_r.Columns.Count).End(xlToLeft).Column
          rg.Copy Destination:=Sh_r.Cells(1, derCol)
          Set rg = rg.Cells(rg.Rows.Count, 1).End(xlDown).CurrentRegion
          If rg.Count = 1 Then continuer = False
     Wend
     Sh_r.Activate
    
End Sub

voir PJ

cp4 · 15 Mars 2023

Bonjour,

Dernière colonne non vide de la 1ère ligne

VB:

dercol = Cells(1,Cells.Columns.Count).End(xltoLeft).Column

momo · 15 Mars 2023

cp4 à dit:
Bonjour,

Dernière colonne non vide de la 1ère ligne

VB:

dercol = Cells(1,Cells.Columns.Count).End(xltoLeft).Column

J'essaie de l'implémenter sans succès

cp4 · 15 Mars 2023

momo à dit:
J'essaie de l'implémenter sans succès

où est ton code? il n'y a aucun code dans ton fichier.

Gégé-45550 · 15 Mars 2023

cp4 à dit:
Bonjour,

Dernière colonne non vide de la 1ère ligne

VB:

dercol = Cells(1,Cells.Columns.Count).End(xltoLeft).Column

@cp4
OUPS !
Pardon, je n'avais pas vu !

momo · 15 Mars 2023

cp4 à dit:
où est ton code? il n'y a aucun code dans ton fichier.

VB:

Sub enr()

Dim WsS As Worksheet

Dim WsC As Worksheet

    Set WsS = Worksheets("Base"): Set WsC = Worksheets("Destination")

    WsS.Range("E4:L44").Copy WsC.Cells(5, WsC.Cells(5, Columns.Count).End(xlToLeft).Column + 1)

    Set WsS = Nothing: Set WsC = Nothing

End Sub

Ce que je suis obligé de faire actu c'est de supprimer manuellement chaque tableau de la plage "E4:L44" de l'onglet pour exécuter la macro.

Ce que je voudrais arriver à faire c'est de pouvoir atteindre automatiquement a prochaine page de tableau et e copier. Chaque tableau est séparé par une ligne vide

AtTheOne · 15 Mars 2023

Bonjour à toutes & à tous,
bonjour @momo
J'y vais de ma solution :

VB:

Sub Bas_Vers_Droite()

     Const col_déb = 1, lgn_déb = 1
     Dim Sh As Worksheet, Sh_r As Worksheet, rg As Range, derCol As Integer
     Set Sh = ThisWorkbook.Worksheets("Test")
    
     ThisWorkbook.Worksheets.Add after:=Sh
     Set Sh_r = ActiveSheet
    
     continuer = True
     Set rg = Sh.Cells(lgn_déb, col_déb).CurrentRegion
     While continuer
          derCol = Sh_r.Cells(lgn_déb, Sh_r.Columns.Count).End(xlToLeft).Column
          rg.Copy Destination:=Sh_r.Cells(1, derCol)
          Set rg = rg.Cells(rg.Rows.Count, 1).End(xlDown).CurrentRegion
          If rg.Count = 1 Then continuer = False
     Wend
     Sh_r.Activate
    
End Sub

voir PJ

momo · 15 Mars 2023

AtTheOne à dit:
Bonjour à toutes & à tous,
bonjour @momo
J'y vais de ma solution :

C'est génial! Ca marche Impec
Merci

Microsoft 365 Compil de tableaux vers la droite

momo

XLDnaute Occasionnel

Pièces jointes

AtTheOne

cp4

XLDnaute Barbatruc

momo

XLDnaute Occasionnel

cp4

XLDnaute Barbatruc

Gégé-45550

XLDnaute Accro

momo

XLDnaute Occasionnel

AtTheOne

XLDnaute Accro

Pièces jointes

momo

XLDnaute Occasionnel

Discussions similaires