Copier colonnes vers une autre feuille

maval

XLDnaute Barbatruc
Bonjour,

J'ai sur une feuille "Liste "avec 26 colonnes portant des noms que j'aimerai copier et coller les 26 colonnes dans la feuille "index" dans colonnes "A".

Je vous remercie de votre aide.
Cordialement

Max
 

Pièces jointes

  • Copy Coller.xlsm
    493.7 KB · Affichages: 164

ChTi160

XLDnaute Barbatruc
Bonjour Max
Bonjour Le fil ,Le Forum
une approche parmi tant d'autres
j'ai mis dans un module Standard
VB:
Option Explicit
Dim Tab_Recup As Variant
Dim DerLgn_1 As Variant
Dim DerLgn_2 As Variant
Dim Dercol As Byte
Dim C As Long

Sub TestTransfert()
With Sheets("Index")
    .Columns(1).ClearContents 'on efface les donnees
End With
    With Sheets("Liste")
    Dercol = .Cells(3, Columns.Count).End(xlToLeft).Column 'On determine la derniere Colonne de la Feuille "Liste"  
      For C = 1 To Dercol 'pour chacune de ces Colonnes
          DerLgn_1 = .Cells(.Rows.Count, C).End(xlUp).Row 'on determine la derniere Ligne Non vide
            ' de cette Colonne en partant du bas
             Tab_Recup = .Range(.Cells(4, C), .Cells(DerLgn_1, C)).Value 'on récupére les valeurs de la plage ainsi définie
          DerLgn_2 = Sheets("Index").Cells(Sheets("Index").Rows.Count, 1).End(xlUp).Row + 1 'on determine la derniere Ligne Non vide
            ' de la premiere Colonne de la Feuille "Index" en partant du bas
              Sheets("Index").Cells(DerLgn_2, 1).Resize(UBound(Tab_Recup, 1), 1) = Tab_Recup 'on redimmensionne la plage et on colle les données
      Next C
    End With
Set Tab_Recup = Nothing
End Sub
Bonne journée
Amicalement
Jean marie
 

fanfan38

XLDnaute Barbatruc
Bonjour
je t'ai fait 2 macros
l'une copie les 26 colonnes sur la colonne A comme demandé
l'autre copie les même données sur la colonne i pour le code insee et la colonne J pour le nom
 

Pièces jointes

  • Copy Coller.xlsm
    1.1 MB · Affichages: 32

Staple1600

XLDnaute Barbatruc
Bonjour le fil, le forum, maval

Est-ce que ceci peut faire l'affaire?
VB:
Sub a()
Dim i&
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
With Feuil1
.Columns(1).Clear
    For i = 1 To 26
    Feuil2.Range(Cells(3, i), Cells(Rows.Count, i).End(xlUp)).Copy .Cells(Rows.Count, 1).End(3)(2)
    Next
End With
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
End Sub

[EDITION] Houps, pas rafrachi
Bonjour Jean-Marie, bonjour fanfan38
 
Dernière édition:

Discussions similaires

Réponses
7
Affichages
410

Membres actuellement en ligne

Statistiques des forums

Discussions
312 084
Messages
2 085 194
Membres
102 813
dernier inscrit
kaiyi