Microsoft 365 Création d'une macro VBA - copier coller dans un nouveau tableau

dixloup · 25 Septembre 2023

Bonjour,

Je suis nouveau sur ce forum et novice sur Excel, et j'essaye de progresser notamment sur la conception de macro.
J'ai une liste d'invité renseigné en colonne A, puis en colonne B le regime alimentaire de chaque invité, et en 3ieme colonne j'ai le numéro de la table ou la personne est assise.
Je souhaiterai faire un tableau recapitulatif sur un second classeur où les invités seraient répertoriés par table avec leur régime alimentaire ....
J'ai écris un code, en m'inspirant de divers tuto, le code "fonctionne" (pas de message d'erreur) mais pas d'action de copier coller.

pouvez-vous m'aider ?

Merci pour votre aide

job75 · 26 Septembre 2023

Pour tester j'ai recopié le tableau A2:C12 de la 1ère feuille sur 11 000 lignes.

La macro s'exécute chez moi en 1,1 seconde, c'est tout à fait acceptable.

Mais il y a lieu de revoir la question des bordures, alors utilisez :

VB:

Private Sub Worksheet_Activate()
Dim i&, col As Variant, c As Range
Application.ScreenUpdating = False
Range("A2:V" & Rows.Count).Delete xlUp 'RAZ
With Sheets("LISTE DETAILLE").[A1].CurrentRegion
    For i = 2 To .Rows.Count
        col = Application.Match("*" & .Cells(i, 2), Rows(1), 0)
        If IsNumeric(col) Then
            Set c = Cells(Rows.Count, col).End(xlUp)(2)
            c = .Cells(i, 1)
            c(1, 2) = .Cells(i, 3)
        End If
    Next
End With
'---bordures---
With...

chaelie2015 · 25 Septembre 2023

Bonjour
Un exemple explicatif vous aidera davantage à trouver des réponses.
A+

Staple1600 · 25 Septembre 2023

Bonsoir @dixloup , @chaelie2015

Si j'ai bien compris
(ne fonctionne que sur le fichier exemple tel qu'il est agencé)

Code:

Sub test()
For i = 2 To 12
Sheets("TABLES").Cells(2, (i - 2) + (i - 1)).Value = Cells(i, 1).Value
Sheets("TABLES").Cells(2, (i - 2) + (i - 1)).Offset(, 1) = Cells(i, 3).Value
Next
Sheets("TABLES").Cells(1).CurrentRegion.Columns.AutoFit
End Sub

Il faut lancer la macro en étant sur la feuille LISTE DETAILLE

chaelie2015 · 25 Septembre 2023

dixloup à dit:
Bonjour Chaelie,

J’ai joint mon fichier Excel à ma question en pensant que tout le monde pouvait le voir afin que ça soit plus parlant avec le ficher sous les yeux Regarde la pièce jointe 1179627 Regarde la pièce jointe 1179628

Bonsoir
A word to the wise is sufficient
A+

dixloup · 26 Septembre 2023

Le copier coller fonctionne bien, mais j’aimerai que le nom et prénom se copie colle sous la table correspondante dans l’onglet table :

Exemple : si je modifie les 3 premières personnes et que dans la colonne plan de table je les met en table 1 , j’aimerai qu’en exécutant la macro , ces personnes se copie collent avec leur régime alimentaire sous le tableau « table 1 » dans l’onglet « tables »
Et idem si je modifie d’autres personnes en table 2 … j’aimerai qu’ils se collent en dessous de « table 2 »

Je sais pas si c’est plus facile pour créer le code , on peut modifier la colonne plan de table , et plutôt que de mettre le chiffre correspondant à la table , je peux mettre tout en texte « table 1 » « table 2 »… afin que cela corresponde à la première ligne du tableau de l’onglet « tables »

chaelie2015 · 26 Septembre 2023

dixloup à dit:
Le copier coller fonctionne bien, mais j’aimerai que le nom et prénom se copie colle sous la table correspondante dans l’onglet table :

Exemple : si je modifie les 3 premières personnes et que dans la colonne plan de table je les met en table 1 , j’aimerai qu’en exécutant la macro , ces personnes se copie collent avec leur régime alimentaire sous le tableau « table 1 » dans l’onglet « tables »
Et idem si je modifie d’autres personnes en table 2 … j’aimerai qu’ils se collent en dessous de « table 2 »

Je sais pas si c’est plus facile pour créer le code , on peut modifier la colonne plan de table , et plutôt que de mettre le chiffre correspondant à la table , je peux mettre tout en texte « table 1 » « table 2 »… afin que cela corresponde à la première ligne du tableau de l’onglet « tables »

Bonjour
Les exemples permettent d'élucider le problème.

job75 · 26 Septembre 2023

Bonjour dixloup, chaelie2015, JM,

Voyez le fichier joint et cette macro dans le code de la feuille "TABLES" :

VB:

Private Sub Worksheet_Activate()
Dim i&, col As Variant, c As Range
Application.ScreenUpdating = False
Range("A2:V" & Rows.Count).ClearContents 'RAZ
With Sheets("LISTE DETAILLE").[A1].CurrentRegion
    For i = 2 To .Rows.Count
        col = Application.Match("*" & .Cells(i, 2), Rows(1), 0)
        If IsNumeric(col) Then
            Set c = Cells(Rows.Count, col).End(xlUp)(2)
            c = .Cells(i, 1)
            c(1, 2) = .Cells(i, 3)
        End If
    Next
End With
Columns.AutoFit 'ajustement largeurs
End Sub

Elle se déclenche automatiquement quand on active la feuille.

A+

dixloup · 26 Septembre 2023

job75 à dit:

Bonjour dixloup, chaelie2015, JM,

Voyez le fichier joint et cette macro dans le code de la feuille "TABLES" :

VB:

Private Sub Worksheet_Activate()
Dim i&, col As Variant, c As Range
Application.ScreenUpdating = False
Range("A2:V" & Rows.Count).ClearContents 'RAZ
With Sheets("LISTE DETAILLE").[A1].CurrentRegion
    For i = 2 To .Rows.Count
        col = Application.Match("*" & .Cells(i, 2), Rows(1), 0)
        If IsNumeric(col) Then
            Set c = Cells(Rows.Count, col).End(xlUp)(2)
            c = .Cells(i, 1)
            c(1, 2) = .Cells(i, 3)
        End If
    Next
End With
Columns.AutoFit 'ajustement largeurs
End Sub

Elle se déclenche automatiquement quand on active la feuille.

A+

Bonjour @job75

C'est exactement ce que je cherchais à faire
Merci pour votre aide précieuse... et en plus qui s'active quand on se met sur la feuille c'est le petit plus qui fait la différence
Merci beaucoup de m'avoir aider sur cette problématique
Merci à @Staple1600 pour sa contribution
et merci à @chaelie2015 de m'avoir aider dans l'explication de mon problème pas facile de se faire comprendre quand on baigne pas dans le monde de VBA au quotidien ...

job75 · 26 Septembre 2023

Pour tester j'ai recopié le tableau A2:C12 de la 1ère feuille sur 11 000 lignes.

La macro s'exécute chez moi en 1,1 seconde, c'est tout à fait acceptable.

Mais il y a lieu de revoir la question des bordures, alors utilisez :

VB:

Private Sub Worksheet_Activate()
Dim i&, col As Variant, c As Range
Application.ScreenUpdating = False
Range("A2:V" & Rows.Count).Delete xlUp 'RAZ
With Sheets("LISTE DETAILLE").[A1].CurrentRegion
    For i = 2 To .Rows.Count
        col = Application.Match("*" & .Cells(i, 2), Rows(1), 0)
        If IsNumeric(col) Then
            Set c = Cells(Rows.Count, col).End(xlUp)(2)
            c = .Cells(i, 1)
            c(1, 2) = .Cells(i, 3)
        End If
    Next
End With
'---bordures---
With [A1].CurrentRegion
    .Borders.Weight = xlThin
    For col = 1 To .Columns.Count Step 2
        .Cells(1, col).Resize(.Rows.Count, 2).BorderAround Weight:=xlMedium 'pourtour
    Next
End With
Columns.AutoFit 'ajustement largeurs
End Sub

Microsoft 365 Création d'une macro VBA - copier coller dans un nouveau tableau

dixloup

XLDnaute Nouveau

Pièces jointes

job75

chaelie2015

XLDnaute Accro

Staple1600

XLDnaute Barbatruc

chaelie2015

XLDnaute Accro

dixloup

XLDnaute Nouveau

chaelie2015

XLDnaute Accro

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

dixloup

XLDnaute Nouveau

job75

XLDnaute Barbatruc

Pièces jointes

Discussions similaires