Regrouper les colonnes 2 à 2

LE MATIN

XLDnaute Occasionnel
bonjour à tous
Je vous joins un petit fichier, je pense plus explicite que mes explications.
je souhaite regrouper 2 à 2 les colonnes, pour obtenir seulement une colonne "Code" et une colonne "PU HT "
j'ai plusieurs pages c'est à dire le rappel de l'entête à plusieurs reprise dans le fichier
J'ai trouvé sur le sîte un code VBA pour regrouper plusieurs colonnes en une seule mais pas pour un regroupement 2 à 2
merci par avance pour vos réponses
 

Pièces jointes

  • exemple.xls
    16 KB · Affichages: 36
  • exemple.xls
    16 KB · Affichages: 36
  • exemple.xls
    16 KB · Affichages: 40

job75

XLDnaute Barbatruc
Re : Regrouper les colonnes 2 à 2

Bonjour LE MATIN,

Ce n'est pas très clair.

Vous nous présentez 2 tableaux identiques et vous ne montrez pas ce qu'il faut obtenir.

Alors peut-être le fichier joint avec cette macro :

Code:
Sub Deux_Colonnes()
'Feuil1 et Feuil2 sont les CodeNames des feuilles
Dim P As Range, h&, lig&, col%
Set P = Feuil1.[A1:N7] 'à adapter
h = P.Rows.Count - 1
lig = 2
Application.ScreenUpdating = False
With Feuil2
  .Cells.Delete 'RAZ
  P(1).Resize(, 2).Copy .[A1] 'titres
  For col = 1 To P.Columns.Count Step 2
    P(2, col).Resize(h, 2).Copy .Cells(lig, 1)
    lig = lig + h
  Next
  .Activate 'facultatif
End With
End Sub
Elle s'exécute quand on active la feuille "Deux colonnes".

Edit : hello pierrejean, je suis très en retard :rolleyes:

A+
 

Pièces jointes

  • Deux colonnes(1).xls
    39.5 KB · Affichages: 22

job75

XLDnaute Barbatruc
Re : Regrouper les colonnes 2 à 2

Re,

Bon, s'il y a plusieurs tableaux à copier :

Code:
Sub Deux_Colonnes()
Dim F As Worksheet, a, lig&, i%, P As Range, h&, col%
Set F = Feuil1 'CodeName
a = Array("A1:N7", "A8:N14") 'adresses des tableaux, à adapter
lig = 2
Application.ScreenUpdating = False
With Feuil2 'CodeName
  .Cells.Delete 'RAZ
  F.Range(a(0)).Resize(1, 2).Copy .[A1] 'titres
  For i = 0 To UBound(a)
    Set P = F.Range(a(i))
    h = P.Rows.Count - 1
    For col = 1 To P.Columns.Count Step 2
      P(2, col).Resize(h, 2).Copy .Cells(lig, 1)
      lig = lig + h
    Next
  Next
  .Activate 'facultatif
End With
End Sub
Notez que les tableaux peuvent être situés n'importe où et être de dimensions quelconques.

Fichier (2).

A+
 

Pièces jointes

  • Deux colonnes(2).xls
    41.5 KB · Affichages: 25

LE MATIN

XLDnaute Occasionnel
Re : Regrouper les colonnes 2 à 2

Bonjour pierrejean, job75, le forum,
merci a vous 2 pour vos réponses.
le code de pierrrejean fonctionne parfaitement . merci :)

@ job75: du coup, pas trop testé le tien :eek: mais je le garde sous le coude ça peut toujours servir.
encore merci à vous deux.
 

Discussions similaires

Réponses
7
Affichages
228