Copier/Coller N Nombre de fois

  • Initiateur de la discussion Initiateur de la discussion maval
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

maval

XLDnaute Barbatruc
Bonjour,

J'ai sur une feuille en colonne A des chiffre et en colonne B un texte "Circonscription"

Suivant le nombre qui se trouve dans la cellule "J3" je voudrais copier/ coller le texte et les chiffre.
Mon fichier exemple seras plus explicite.

Merci d'avance

Max
 

Pièces jointes

Re
je viens de tester la procédure de M12
Pour que cela tourne sans problème d 'effacement de la cellule "B5"
j'ai du modifier la Ligne suivant :
VB:
Dl = Range("A" & Rows.Count).End(xlUp).Row 
en Dl = Range("A" & Rows.Count).End(xlUp).Row + 1
je n'ai pas dans ma proposition inclus l'effacement de la pllage cible lol
Bonne journée
jean marie
 
Re
j'ai modifié la procédure de mon fichier (à tester)
VB:
Option Explicit
Dim DerLgn As Integer
Dim Lgn As Integer
Dim StrWord As String
Dim Nbr As Integer
Public Sub test()
    With Feuil1
         Nbr = .Cells(3, 10) 'On récupére le Nombre de fois
     StrWord = .Cells(5, 2) 'oN récupére le texte
If StrWord = "" Then Exit Sub 'si pas de texte on quitte
       With .Range(.Cells(5, 1), .Cells(10000, 2)) ' avec la plage ainsi définie
            .ClearContents 'on l'efface
            .Cells(1, 1).Resize(, 2) = Array(1, StrWord)'On colle  dans la première  plage cible            
       End With
     For Lgn = 2 To Nbr 'pour chaque ligne de la deuxième à la X
       DerLgn = .Cells(.Rows.Count, 2).End(xlUp).Row + 1 'on détermine la cligne cible
         .Cells(DerLgn, 1).Resize(, 2) = Array(Lgn, StrWord) 'on  colle dans la plage ainsi définie les éléments
     Next Lgn
    End With
End Sub
Edit : à 8:55
Bonne journée
jean marie
 
Dernière édition:
Re Jean Marie

Je te remercie. Pourrais tu me dire comment je peut mettre en VBA cette Formule.
Code:
=SI(ESTVIDE(A5);" ";"><tspan x=""0"" y=""0"" class=""texte"">"&A5&"</tspan><tspan x=""0"" y=""0"" class=""texte"" baseline-shift=""super"">ére</tspan><tspan x=""0"" y=""0"" class=""texte"">"&B5&"</tspan></text>")

ou mon fichier
 

Pièces jointes

Bonjour maval, M12, Jean-Marie,

Eviter les boucles quand c'est possible :
Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column <> 2 Or Target(1) = "" Then Exit Sub
Cancel = True
Target(1, 0) = 1
Target(1, 0).Resize([J3]).DataSeries
Target.Resize([J3]) = Target
Columns(1).AutoFit
End Sub
A+
 

Pièces jointes

Re
pas évident de comprendre
à quoi correspondent les Mot "texte" et "super" et x et y sont ils toujours = à 0
peux tu mettre des exemple de ce que doit contenir la formule .
exemple :
=SI(ESTVIDE(A5);" ";"><tspan x=""0"" y=""0"" class=""texte"">"& A5 &"</tspan><tspan x=""0"" y=""0"" class=""texte"" baseline-shift=""super"">ére</tspan><tspan x=""0"" y=""0"" class=""texte"">"& B5 &"</tspan></text>")
dans l'attente
jean marie
 
Re,

Pour le dernier problème :
Code:
Sub Test()
'---résultats en colonne D---
Dim c As Range
If Application.Count([A:A]) = 0 Then Exit Sub
For Each c In [A:A].SpecialCells(xlCellTypeConstants, 1)
    c.Name = "a": c(1, 2).Name = "b" 'cellules nommées
    c(1, 4) = [IF(ISBLANK(a)," ","><tspan x=""0"" y=""0"" class=""texte"">"&a&"</tspan><tspan x=""0"" y=""0"" class=""texte"" baseline-shift=""super"">ème</tspan><tspan x=""0"" y=""0"" class=""texte"">"&b&"</tspan></text>")]
    If [a] = 1 Then c(1, 4).Replace "ème", "ère", xlPart
Next
End Sub
A+
 
Re M12

J'ai une erreur à la place &i je devrais avoir la correspondance de la colonne "A" soit 1

Code:
><tspan x="0" y="0" class="texte">"&i</tspan><tspan x="0" y="0" class="texte" baseline-shift="super">ére</tspan><tspan x="0"" y="0" class="texte">Circonscription</tspan></text>")

Merci
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
2
Affichages
350
Retour