Microsoft 365 Compil de tableaux vers la droite

momo

XLDnaute Occasionnel
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
 

Pièces jointes

  • compil vers la droite de tableaux.xlsx
    27.5 KB · Affichages: 9
Solution
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

XLDnaute Occasionnel
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
 
Dernière édition:

AtTheOne

XLDnaute Accro
Supporter XLD
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
 

Pièces jointes

  • compil vers la droite de tableaux.xlsm
    28.5 KB · Affichages: 2

Discussions similaires

Réponses
4
Affichages
287

Statistiques des forums

Discussions
313 274
Messages
2 096 750
Membres
106 737
dernier inscrit
zaka