XL 2013 Transfert de données réparties sur X colonnes dans 3 colonnes

AngieMot33

XLDnaute Nouveau
Bonjour,

Je viens vers vous car je ne sis pas assez expérimentée pour effectuer une formule ou une macro qui pourrait me faciliter la vie et me faire gagner un temps non négligeable dans mon travail.

Comme ce que je souhaite est un peu compliqué à exprimer, je l'ai schématisé dans le fichier joint.

J'espère que vous pourrez m'apporter une réponse, une aide, une explication de ce que je peux faire.

Je vous remercie d'ores et déjà pour le temps que vous prendrez à étudier ou simplement lire ma demande.

Je vous souhaite une excellente fin de journée,

Angélique
 

Pièces jointes

  • TEST - SAS 5 import ZD.xlsm
    82.5 KB · Affichages: 13
Solution
Voici la macro avec le résultat dans la feuille "Résultat" :
VB:
Private Sub Worksheet_Activate()
Dim nlig&, tablo, resu(), n&, j%, i&
With Sheets("Feuil1").[A5].CurrentRegion 'adapter le nom de la feuille
    nlig = .Rows.Count
    If nlig = 1 Or .Columns.Count < 3 Then GoTo 1 'sécurité
    tablo = .Value 'matrice, plus rapide
End With
ReDim resu(1 To nlig * Int(UBound(tablo, 2) / 2), 1 To 3)
n = 1: resu(1, 1) = "ESI": resu(1, 2) = "Code ZD": resu(1, 3) = "Valeur ZD"
For j = 3 To 2 * Int(UBound(tablo, 2) / 2) Step 2
    For i = 2 To nlig
        n = n + 1
        resu(n, 1) = tablo(i, 1)
        resu(n, 2) = tablo(i, j)
        resu(n, 3) = tablo(i, j + 1)
Next i, j
'---restitution---
1 Application.ScreenUpdating = False
If FilterMode...

soan

XLDnaute Barbatruc
Inactif
Bonsoir Angélique,

bienvenue sur le site XLD ! :)

ton fichier en retour ; fais Ctrl e ➯ travail effectué ! 😊

code VBA de Module4 :

VB:
Option Explicit

Dim lig&

Private Sub Job(n1&, k As Byte)
  [A6].Resize(n1).Copy Cells(lig, 11)
  [C6].Offset(, k).Resize(n1, 2).Copy Cells(lig, 12)
  lig = lig + n1
End Sub

Sub CpyData()
  If ActiveSheet.Name <> "Feuil1" Then Exit Sub
  Dim m&, n1&
  m = Rows.Count: n1 = Cells(m, 1).End(3).Row: If n1 = 5 Then Exit Sub
  Dim n2&: n2 = Cells(m, 11).End(3).Row: Application.ScreenUpdating = 0
  If n2 > 5 Then Range("K6:M" & n2).ClearContents
  n1 = n1 - 5: lig = 6: Job n1, 0: Job n1, 4
End Sub

si besoin, tu peux demander une adaptation.
à te lire pour avoir ton avis. ;)

soan
 

Pièces jointes

  • TEST - SAS 5 import ZD.xlsm
    93.9 KB · Affichages: 7
Dernière édition:

job75

XLDnaute Barbatruc
Bonjour AngieMot33, soan, le forum,

Sur la feuille il est précisé "Colonnes C à AN" donc il peut y avoir jusqu'à 19 fois 2 colonnes à copier.

Question : sur l'exemple du post #1 pourquoi ne pas avoir copié les colonnes E:F (comme C: D et G:H) ?

A+
 

AngieMot33

XLDnaute Nouveau
Bonsoir Angélique,

bienvenue sur le site XLD ! :)

ton fichier en retour ; fais Ctrl e ➯ travail effectué ! 😊

code VBA de Module4 :

VB:
Option Explicit

Dim lig&

Private Sub Job(n1&, k As Byte)
  [A6].Resize(n1).Copy Cells(lig, 11)
  [C6].Offset(, k).Resize(n1, 2).Copy Cells(lig, 12)
  lig = lig + n1
End Sub

Sub CpyData()
  If ActiveSheet.Name <> "Feuil1" Then Exit Sub
  Dim m&, n1&
  m = Rows.Count: n1 = Cells(m, 1).End(3).Row: If n1 = 5 Then Exit Sub
  Dim n2&: n2 = Cells(m, 11).End(3).Row: Application.ScreenUpdating = 0
  If n2 > 5 Then Range("K6:M" & n2).ClearContents
  n1 = n1 - 5: lig = 6: Job n1, 0: Job n1, 4
End Sub

si besoin, tu peux demander une adaptation.
à te lire pour avoir ton avis. ;)

soan
Bonjour Soan,

Wouah c'est extra !!!!! C'est exactement ce que je souhaite !!!
Je souhaiterais pouvoir l'adapter à l'onglet "EXPORT ZD VIA ARBO" copier les données des colonnes C à AN dans l'onglet "SAS IMPORT ZD" en ignorant les vides.
Est- ce que c'est possible ?
Dans le cas contraire je ferai une copie des valeurs, et il faudrait juste décaler le résultat des colonnes K à M aux colonnes AP à AR ...
Je me débrouille à peu près en VBA sur des petites macros, mais là c'est du "high level"!!!!
Bravo et mille mercis !!!
Je vous souhaite une très belle journée !
 

AngieMot33

XLDnaute Nouveau
Bonjour AngieMot33, soan, le forum,

Sur la feuille il est précisé "Colonnes C à AN" donc il peut y avoir jusqu'à 19 fois 2 colonnes à copier.

Question : sur l'exemple du post #1 pourquoi ne pas avoir copié les colonnes E:F (comme C: D et G:H) ?

A+
Bonjour Job 75,
Oui en effet j'ai fait une demande d'adaptation en réponse à @soan, car en fait c'est le contenu des colonnes C à AN de l'onglet EXPORT ZD VIA ARBO qui doivent se coller à la suite dans les colonnes K;L;M en évitant les vides ...
Ce sont des groupes de colonnes : C:D ; E:F ; G:H; ...; AM:AN qui doivent se copier, en répétant la colonne A

Mais ma demande de départ en effet n'était peut-être pas assez explicite.

Merci pour votre aide !
 

soan

XLDnaute Barbatruc
Inactif
Bonjour job75, Angélique, le fil,

Sur la feuille il est précisé "Colonnes C à AN" donc il peut y avoir jusqu'à 19 fois 2 colonnes à copier.

effectivement, mais comme dans le fichier exemple seules les colonnes A à H sont présentes, j'ai fait ma macro avec ces données ; pour des colonnes supplémentaires I à AN, il faudra bien sûr adapter la macro en conséquence ! en l'occurrence, il s'agirait de faire autant d'appels à la sub Job() qu'il y a de colonnes à copier ; et pour éviter de faire une longue liste d'appels successifs à Job(), il faudrait inclure l'appel de Job() dans une boucle, en paramétrant correctement le second argument transmis (le 1er argument étant toujours le même : n1) ; d'ailleurs, pour éviter aussi, justement, de transmettre le 1er argument à chaque appel, ce serait judicieux de mettre n1 en tant que variable globale, comme je l'ai déjà fait pour lig. :)



Question : sur l'exemple du post #1 pourquoi ne pas avoir copié les colonnes E:F (comme C: D et G:H) ?

ah, ben ça, c'est ce que voulait le demandeur ; j'ai juste fait comme Angélique le désirait. 😊

soan
 

soan

XLDnaute Barbatruc
Inactif
Angélique

Wouah c'est extra !!!!! C'est exactement ce que je souhaite !!!

Bravo et mille mercis !!!

merci pour ton retour ! 😊



pour ce que tu demandes ensuite, ainsi que pour ton post #6, je pourrai t'aider davantage si tu joins un fichier exemple sans données confidentielles, avec les mêmes feuilles que celles que tu as mentionnées, et avec beaucoup de données à copier (pour que je ne perde pas de temps juste pour en inventer ! 😜).​

soan
 

job75

XLDnaute Barbatruc
Avec cette macro toutes les colonnes à partir de la colonne C sont recopiées, quel que soit leur nombre :
VB:
Sub Resultat()
Dim nlig&, tablo, resu(), n&, j%, i&
With Sheets("Feuil1").[A5].CurrentRegion 'adapter le nom de la feuille
    nlig = .Rows.Count
    If nlig = 1 Or .Columns.Count < 3 Then Exit Sub 'sécurité
    tablo = .Value 'matrice, plus rapide
    ReDim resu(1 To nlig * Int(UBound(tablo, 2) / 2), 1 To 3)
    n = 1: resu(1, 1) = "ESI": resu(1, 2) = "Code ZD": resu(1, 3) = "Valeur ZD"
    For j = 3 To 2 * Int(UBound(tablo, 2) / 2) Step 2
        For i = 2 To nlig
            n = n + 1
            resu(n, 1) = tablo(i, 1)
            resu(n, 2) = tablo(i, j)
            resu(n, 3) = tablo(i, j + 1)
    Next i, j
    '---restitution---
    Application.ScreenUpdating = False
    If .Parent.FilterMode Then .Parent.ShowAllData 'si la feuille est filtrée
    With .Cells(1, .Columns.Count + 2) '1ère cellule de destination
        .EntireColumn.Resize(, .Parent.Columns.Count - .Column + 1).ClearContents 'RAZ
        .Resize(n, 3) = resu
    End With
    With .Parent.UsedRange: End With 'actualise les barres de défilement
End With
End Sub
Le résultat est dans la même feuille mais on pourrait utiliser une autre feuille.
 

Pièces jointes

  • TEST - SAS 5 import ZD(1).xlsm
    68.7 KB · Affichages: 4

job75

XLDnaute Barbatruc
Voici la macro avec le résultat dans la feuille "Résultat" :
VB:
Private Sub Worksheet_Activate()
Dim nlig&, tablo, resu(), n&, j%, i&
With Sheets("Feuil1").[A5].CurrentRegion 'adapter le nom de la feuille
    nlig = .Rows.Count
    If nlig = 1 Or .Columns.Count < 3 Then GoTo 1 'sécurité
    tablo = .Value 'matrice, plus rapide
End With
ReDim resu(1 To nlig * Int(UBound(tablo, 2) / 2), 1 To 3)
n = 1: resu(1, 1) = "ESI": resu(1, 2) = "Code ZD": resu(1, 3) = "Valeur ZD"
For j = 3 To 2 * Int(UBound(tablo, 2) / 2) Step 2
    For i = 2 To nlig
        n = n + 1
        resu(n, 1) = tablo(i, 1)
        resu(n, 2) = tablo(i, j)
        resu(n, 3) = tablo(i, j + 1)
Next i, j
'---restitution---
1 Application.ScreenUpdating = False
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A1] '1ère cellule de destination
    .EntireColumn.Resize(, Columns.Count - .Column + 1).ClearContents 'RAZ
    If n Then .Resize(n, 3) = resu
End With
With UsedRange: End With 'actualise les barres de défilement
End Sub
Elle se déclenche automatiquement quand on active la feuille, voyez ce fichier (2).
 

Pièces jointes

  • TEST - SAS 5 import ZD(2).xlsm
    69.2 KB · Affichages: 12

AngieMot33

XLDnaute Nouveau
Voici la macro avec le résultat dans la feuille "Résultat" :
VB:
Private Sub Worksheet_Activate()
Dim nlig&, tablo, resu(), n&, j%, i&
With Sheets("Feuil1").[A5].CurrentRegion 'adapter le nom de la feuille
    nlig = .Rows.Count
    If nlig = 1 Or .Columns.Count < 3 Then GoTo 1 'sécurité
    tablo = .Value 'matrice, plus rapide
End With
ReDim resu(1 To nlig * Int(UBound(tablo, 2) / 2), 1 To 3)
n = 1: resu(1, 1) = "ESI": resu(1, 2) = "Code ZD": resu(1, 3) = "Valeur ZD"
For j = 3 To 2 * Int(UBound(tablo, 2) / 2) Step 2
    For i = 2 To nlig
        n = n + 1
        resu(n, 1) = tablo(i, 1)
        resu(n, 2) = tablo(i, j)
        resu(n, 3) = tablo(i, j + 1)
Next i, j
'---restitution---
1 Application.ScreenUpdating = False
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A1] '1ère cellule de destination
    .EntireColumn.Resize(, Columns.Count - .Column + 1).ClearContents 'RAZ
    If n Then .Resize(n, 3) = resu
End With
With UsedRange: End With 'actualise les barres de défilement
End Sub
Elle se déclenche automatiquement quand on active la feuille, voyez ce fichier (2).
Mille mercis !!!!! C'est exactement celà !!! Je suis époustouflée !!! Vraiment un grand merci !
Je suis admirative
 

AngieMot33

XLDnaute Nouveau
Angélique





merci pour ton retour ! 😊



pour ce que tu demandes ensuite, ainsi que pour ton post #6, je pourrai t'aider davantage si tu joins un fichier exemple sans données confidentielles, avec les mêmes feuilles que celles que tu as mentionnées, et avec beaucoup de données à copier (pour que je ne perde pas de temps juste pour en inventer ! 😜).​

soan
Soan, Job75 a parfaitement répondu à mon besoin. Donc je ne veux pas vous faire perdre plus de temps que celui que vous avez déjà consacré à ma demande.🙏
Je vous remercie pour le temps passé, et la réponse proposée, en effet c'est ma faute la demande initiale n'était pas assez explicite.
Encore Mercie,
Je vous souhaite une belle fin de journée et un excellent Week-end !:)
 

Discussions similaires

Réponses
7
Affichages
626

Statistiques des forums

Discussions
314 450
Messages
2 109 727
Membres
110 552
dernier inscrit
jasson