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

A

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
job75
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...
Trier par date Trier par votes
S

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:
Vote positif 0 Vote négatif
job75

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+
 
Vote positif 0 Vote négatif
A

AngieMot33

XLDnaute Nouveau
soan à dit:
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
Cliquez pour agrandir...
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 !
 
Vote positif 0 Vote négatif
A

AngieMot33

XLDnaute Nouveau
job75 à dit:
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+
Cliquez pour agrandir...
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 !
 
Vote positif 0 Vote négatif
S

soan

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

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

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. :)​


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

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

soan
 
Vote positif 0 Vote négatif
S

soan

XLDnaute Barbatruc
Inactif
Angélique

AngieMot33 à dit:
Wouah c'est extra !!!!! C'est exactement ce que je souhaite !!!
Cliquez pour agrandir...

Bravo et mille mercis !!!
Cliquez pour agrandir...

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
 
Vote positif 0 Vote négatif
job75

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
Vote positif 1 Vote négatif
job75

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
Vote positif 1 Vote négatif
Solution
A

AngieMot33

XLDnaute Nouveau
job75 à dit:
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).
Cliquez pour agrandir...
Mille mercis !!!!! C'est exactement celà !!! Je suis époustouflée !!! Vraiment un grand merci !
Je suis admirative
 
Vote positif 0 Vote négatif
A

AngieMot33

XLDnaute Nouveau
soan à dit:
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
Cliquez pour agrandir...
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 !:)
 
Vote positif 0 Vote négatif

Discussions similaires

M
  • Question
XL 2021 Création d'un document à partir d'un tableau
Réponses
6
Affichages
253
gbinforme
G
Magnio
  • Question
XL 2016 Transfert de données d'un tableau en différenciant les libellés
Réponses
8
Affichages
473
Magnio
Magnio
G
  • Question
Microsoft 365 Transfert de données
Réponses
7
Affichages
688
GClaire
G
S
  • Résolu(e)
Microsoft 365 [Résolu] Aide sur gestionnaires de noms + liste déroulante en cascade associée
Réponses
9
Affichages
675
djidji59430
djidji59430
L
  • Résolu(e)
Power Query Dépivoter colonnes dans PowerQuery
Réponses
7
Affichages
962
job75
job75
M
  • Question
XL 2021 Correction de test psychométrique automatisée
Réponses
4
Affichages
472
TooFatBoy
TooFatBoy
M
  • Question
XL 2019 Réaliser un classement automatique pour un tournoi enfants à Mario Kart
Réponses
2
Affichages
760
michel8032
M
W
  • Question
XL 2016 Transfert de 2 colonnes sans formules et duplication des cellules selon le nbre de fois indiqué en colonne L
Réponses
9
Affichages
613
Webperegrino
W
Z
  • Question
XL 2010 tableau pour comparer deux colonnes et écrire le résultat dans une troisième colonne
2
Réponses
28
Affichages
2 K
zephir94
Z
T
  • Question
Microsoft 365 Cacher / détailler certaines colonnes dans certains onglets avec mot de passe
Réponses
6
Affichages
639
ThierryP
T

Membres actuellement en ligne

4 membres et 61 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 138
Messages
2 116 685
Membres
112 837
dernier inscrit
Sting