Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2021 récupérer des cellules multilignes d'une feuille dans une autre

C

Claudinedu13

XLDnaute Junior
Bonsoir, j'ai besoin de votre aide

Sur ma feuil1 je clique sur le bouton "Remplir Feuil2" pour copier les cellules A7 et B7 sur la feuil2 dans la zone que j'ai nommée "description1" et "description2"

j'obtiens



Alors que je voudrais



Pour infos pour mon projet, les cellules de ma feuil 1 peuvent contenir 1, 2, 3, 4 lignes (pas plus).

J'espère que ma demande est claire




Merci
 

Pièces jointes

  • Classeur.xlsm
    31.3 KB · Affichages: 5
Solution
Re,
Un essai en PJ avec :
VB: 
Sub TransfertSylvanu()
Dim T, DL%, C, Plage
Sheets("Feuil2").[A3:G100].ClearContents
Plage = Array("A7", "B7", "E7", "G7")
For Each C In Plage
    T = Split(Range(C), Chr(10))
    DL = 2 + Sheets("Feuil2").[A1000].End(xlUp).Row
    Sheets("Feuil2").Cells(DL, "A").Resize(1 + UBound(T), 1).Value = Application.Transpose(T)
Next C
End Sub
Trier par date Trier par votes

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonsoir Claudine,
Pas sur d'avoir bien compris, mais un essai en PJ avec :
VB: 
Sub Transfert()
Dim T, DL%
Sheets("Feuil2").[A3:G100].ClearContents
T = Split([A7], Chr(10))
Sheets("Feuil2").[A3].Resize(1 + UBound(T), 1).Value = Application.Transpose(T)
T = Split([B7], Chr(10))
DL = 2 + Sheets("Feuil2").[A1000].End(xlUp).Row
Sheets("Feuil2").Cells(DL, "A").Resize(1 + UBound(T), 1).Value = Application.Transpose(T)
End Sub
 

Pièces jointes

  • Classeur.xlsm
    24 KB · Affichages: 4
Vote positif 0 Vote négatif
F

Franc58

XLDnaute Occasionnel
Salut, voici ma proposition:

VB: 
Sub CopyData()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim rng As Range
    Dim cell As Range
    Dim i As Long
    Dim lines() As String
    Dim line As Variant
    
    Set ws1 = ThisWorkbook.Sheets("Feuil1")
    Set ws2 = ThisWorkbook.Sheets("Feuil2")
    Set rng = ws1.Range("A2:B" & ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row)
    
    i = 4 
    For Each cell In rng
        If cell.Value <> "" Then
            lines = Split(cell.Value, Chr(10))
            For Each line In lines
                ws2.Cells(i, "A").Value = ws1.Cells(1, cell.Column).Value
                ws2.Cells(i, "B").Value = line
                i = i + 1
            Next line
            i = i + 1
        End If
    Next cell
End Sub
 
Vote positif 0 Vote négatif
C

Claudinedu13

XLDnaute Junior
re,
encore une petite requête pour vous @sylvanu et @Franc58 (j'ai essayé seule mais je n'y arrive pas) , je teste vos codes pour voir lequel des 2 je vais mettre dans mon appli,
en plus des cellules A7, B7 je veux aussi rajouter le contenu des cellules E7 et G7 dans ma feuil2 avec le même système que vous m'avez codé
Vos codes sont dans le module 1
MERCI


 

Pièces jointes

  • Classeur.xlsm
    33.9 KB · Affichages: 3
Vote positif 0 Vote négatif

sylvanu

XLDnaute Barbatruc
Supporter XLD
Re,
Un essai en PJ avec :
VB: 
Sub TransfertSylvanu()
Dim T, DL%, C, Plage
Sheets("Feuil2").[A3:G100].ClearContents
Plage = Array("A7", "B7", "E7", "G7")
For Each C In Plage
    T = Split(Range(C), Chr(10))
    DL = 2 + Sheets("Feuil2").[A1000].End(xlUp).Row
    Sheets("Feuil2").Cells(DL, "A").Resize(1 + UBound(T), 1).Value = Application.Transpose(T)
Next C
End Sub
 

Pièces jointes

  • Classeur (V2).xlsm
    24.5 KB · Affichages: 4
Vote positif 0 Vote négatif
Solution
F

Franc58

XLDnaute Occasionnel
Salut, il suffit de modifier rng comme ceci:

VB: 
Sub CopyData()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim rng As Range
    Dim cell As Range
    Dim i As Long
    Dim lines() As String
    Dim line As Variant
    
    Set ws1 = ThisWorkbook.Sheets("Feuil1")
    Set ws2 = ThisWorkbook.Sheets("Feuil2")
    Set rng = Union(ws1.Range("A2:B" & ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row), _
                ws1.Range("E2:E" & ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row), _
                ws1.Range("G2:G" & ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row))
    
    i = 4
    For Each cell In rng
        If cell.Value <> "" Then
            lines = Split(cell.Value, Chr(10))
            For Each line In lines
                ws2.Cells(i, "A").Value = ws1.Cells(1, cell.Column).Value
                ws2.Cells(i, "B").Value = line
                i = i + 1
            Next line
            i = i + 1
        End If
    Next cell
End Sub
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

P
  • Question
XL 2019 Copier des cellules d'une feuille sur une autre
Réponses
2
Affichages
581
phoceenjo
P
M
  • Question
XL 2019 Transposer des données d'une feuille vers une autre sous forme de synthèse
Réponses
8
Affichages
262
mromain
O
  • Résolu(e)
Microsoft 365 Effacer le contenu de cellules si une autre cellule est vide
Réponses
9
Affichages
222
Olihoes
O
  • Résolu(e)
Microsoft 365 Extraction d'informations sur différents onglets en partant d'une base de données
Réponses
7
Affichages
515
MBax
  • Résolu(e)
Microsoft 365 VBA - Coller la valeur d'une cellule d'une autre feuille...
Réponses
11
Affichages
817
13Hubert
R
  • Question
Microsoft 365 Incrémenter un nombre dans cellules d'une colonne selon un filtre sur autre cellules dans une colonne.
Réponses
13
Affichages
512
Rom52
R
C
  • Résolu(e)
XL 2021 Remplir données devis en vba avec descriptions/quantités/PUs alignés
2
Réponses
18
Affichages
1 K
Phil69970
A
  • Question
XL 2021 récupérer la valeur d'une variable en fin de boucle dans une autre procédure
Réponses
5
Affichages
394
Attila451
A
  • Question
Microsoft 365 Macro pour redimensionner une zone nommée
Réponses
12
Affichages
318
Staple1600
L
  • Question
Microsoft 365 Trier des données d'une colonne dans une autre
Réponses
2
Affichages
278
Langrand
L
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…