Valeur automatique reportée

[Moreno076]

Bonsoir à tous.

Voilà, j'ai ci-joint un fichier excel avec deux onglets. Je souhaiterais que les valeurs de la colonne A du 2ème onglets se mettent automatiquement dans la colonne B1 pour la premiere puis B4 etc...
Identique pour les autres valeurs colonne B dans B2 et colonne C dans D2

Est ce que quelqu'un peut me transformer mon fichier svp.

Merci d'avance

 

[Moreno076]

Je pensais à une macro avec bouton qui crée autant d'étiquettes que de valeur.

 

[Hieu]

Salut,

Ne jamais fusionner des cellules, la macro n'aime pas. J'ai défusionné, et centré le texte sur plusieurs colonnes.

Sub mlk()
Set nom = Sheets("Feuil2").Range("a1")
Set code = Sheets("Feuil2").Range("b1")
Set visa = Sheets("Feuil2").Range("c1")

nb = WorksheetFunction.CountA(Sheets("Feuil2").Range("a:a")) - 1
For l = 1 To nb
    Sheets("Feuil1").Range("b1").Offset(i, j) = nom.Offset(l, 0)
    Sheets("Feuil1").Range("b2").Offset(i, j) = code.Offset(l, 0)
    Sheets("Feuil1").Range("d2").Offset(i, j) = visa.Offset(l, 0)
Select Case l Mod 2
    Case 1
        j = 5
    Case 0
        i = i + 3
        j = 0
End Select
Next l
End Sub

 

[Moreno076]

Salut Hieu. Que dire? Un grand merci pour la rapidité et cette efficacité. C'est exactement ce que je voulais. Ok pour la fusion des cellules, promis je ne recommencerais pas ^^.

Encore merci.

Salut,

Ne jamais fusionner des cellules, la macro n'aime pas. J'ai défusionné, et centré le texte sur plusieurs colonnes.

Sub mlk()
Set nom = Sheets("Feuil2").Range("a1")
Set code = Sheets("Feuil2").Range("b1")
Set visa = Sheets("Feuil2").Range("c1")

nb = WorksheetFunction.CountA(Sheets("Feuil2").Range("a:a")) - 1
For l = 1 To nb
    Sheets("Feuil1").Range("b1").Offset(i, j) = nom.Offset(l, 0)
    Sheets("Feuil1").Range("b2").Offset(i, j) = code.Offset(l, 0)
    Sheets("Feuil1").Range("d2").Offset(i, j) = visa.Offset(l, 0)
Select Case l Mod 2
    Case 1
        j = 5
    Case 0
        i = i + 3
        j = 0
End Select
Next l
End Sub

 

[job75]

Bonjour Moreno076, Hieu, le forum,

Les cellules fusionnées ne sont absolument pas gênantes, voyez le fichier joint.

Et avec un tableau VBA c'est plus rapide s'il y a beaucoup de noms :

Private Sub Worksheet_Activate()
Dim source As Range, titre$, dest As Range, td, nlig&, ncol%, i&, j%, memi&, memj%
Set source = Feuil2.UsedRange 'CodeName de la feuille
titre = source(1) 'Nom PLV
Set dest = Me.UsedRange.Resize(, 9) 'largeur 9 colonnes à adapter
td = dest 'matrice, plus rapide
nlig = UBound(td)
ncol = UBound(td, 2) - 3
'---RAZ du tableau de destination---
For i = 1 To nlig
  For j = 1 To ncol
    If td(i, j) Like titre & "*" Then
      td(i, j + 1) = ""
      td(i + 1, j + 1) = ""
      td(i + 1, j + 3) = ""
    End If
Next j, i
'---remplissage du tableau de destination---
memi = 1: memj = 1
For Each source In source.Offset(1).Columns(1).Cells
  If source <> "" Then
    For i = memi To nlig
      For j = memj To ncol
        If td(i, j) Like titre & "*" Then
          td(i, j + 1) = source
          td(i + 1, j + 1) = source(1, 2)
          td(i + 1, j + 3) = source(1, 3)
          If j = ncol Then memi = i + 2
          memj = IIf(j = ncol, 1, j + 4)
          GoTo 1
        End If
        If j = ncol Then memi = i + 1: memj = 1
    Next j, i
  End If
1 Next
dest = td
End Sub

Edit : en Feuil1 les petits tableaux peuvent être disposés comme on veut.

Je râle souvent contre ce vieux saucisson qui traîne sur XLD, ici par exemple :

https://www.excel-downloads.com/threads/besoin-daide-pour-creation-de-bouton.20007950/#post-20059041

A+

 

[Moreno076]

Merci bien.

 

[job75]

Re,

La 1ère restitution après la RAZ n'était pas nécessaire, je l'ai supprimée de la macro précédente.

Par curiosité j'ai testé avec 10 000 noms (sur Win 10- Excel 2013) :

- RAZ : Hieu => 2,33 secondes - job75 => 0,09 seconde (sans restitution)

- remplissage : Hieu => 1,57 seconde - job75 => 0,50 seconde.

A+

 

[job75]

Re,

Si la disposition des tableaux en Feuil1 n'est jamais changée ceci est plus simple mais guère plus rapide :

Private Sub Worksheet_Activate()
Dim source As Range, nlig&, td, i&, n&, j%
Set source = Feuil2.UsedRange.Offset(1).Columns(1) 'CodeName de la feuille
nlig = 3 * Int(3 * Application.CountA(source) / 2) 'tableaux de 2 lignes + 1 espace
ReDim td(1 To nlig, 1 To 9) '9 colonnes
'---remplissage du tableau de destination---
i = -2
For Each source In source.Cells
  If Not IsEmpty(source) Then
    n = n + 1
    If n Mod 2 Then
      i = i + 3
      j = 1
    Else
      j = 6
    End If
    td(i, j) = "Nom"
    td(i, j + 1) = source
    td(i + 1, j) = "Code"
    td(i + 1, j + 1) = source(1, 2)
    td(i + 1, j + 2) = "Visa"
    td(i + 1, j + 3) = source(1, 3)
  End If
Next
'---restitution---
Application.ScreenUpdating = False
[A1].Resize(Rows.Count, 9) = Empty 'RAZ
[A1].Resize(nlig, 9) = td
End Sub

Fichier (2), avec 10 000 noms => 0,50 seconde.

A+

 

[job75]

Bonjour,

Il manquait cette ligne de code au fichier (1) du post #5, j'ai corrigé :

      If j = ncol Then memi = i + 1: memj = 1

A+