XL 2016 Transposer colonnes sur lignes

  • Initiateur de la discussion Initiateur de la discussion soumus
  • 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 !

soumus

XLDnaute Junior
Bonjour cher tous
Je sollicité votre soutien pour résoudre un problème excel. J ai un fichier Excel avec 3 feuilles. Je voudrais un code vba qui va me permettre de copier les données en colonnes sur ma feuille "Cotation "et de les coller en lignes sur la feuille "Base" et ensuite se positionner à la 1ere ligne vide suivante pour la prochaine copie-coller à faire et ainsi de suite.
Merci de votre soutien.
 

Pièces jointes

Bonsoir,

Voici le code qui devrait résoudre la demande :
VB:
Private Sub Copy_base_Click()   ' copie cotation transposée
Dim cli As Long
Dim der As Long
    der = Sheets("Base").Cells(Rows.Count, 6).End(xlUp).Row + 1
    With Sheets("CLIENT")
        cli = .Cells(Rows.Count, 1).End(xlUp).Row
        .Cells(cli, 1).Resize(1, 5).Copy
    End With
    Sheets("Base").Cells(der, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Sheets("Base").Cells(der, 1).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Sheets("Cotation").Range("F10:F36").Copy
    Sheets("Base").Cells(der, 7).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    Sheets("Base").Cells(der, 7).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    Sheets("Cotation").Range("G10:G36").Copy
    Sheets("Base").Cells(der + 1, 7).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    Sheets("Base").Cells(der + 1, 7).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    Sheets("Base").Cells(der + 1, 6).Value = "Taux (%0)"
    Sheets("Cotation").Range("H10:H36").Copy
    Sheets("Base").Cells(der + 2, 7).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    Sheets("Base").Cells(der + 2, 7).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    Sheets("Base").Cells(der + 2, 6).Value = "Primes"
    Application.CutCopyMode = False
    Sheets("Base").Activate
    Sheets("Base").Cells(der, 1).Activate
End Sub

Bonne utilisation

Cordialement
 
Bonsoir,

Voici le code qui devrait résoudre la demande :
VB:
Private Sub Copy_base_Click()   ' copie cotation transposée
Dim cli As Long
Dim der As Long
    der = Sheets("Base").Cells(Rows.Count, 6).End(xlUp).Row + 1
    With Sheets("CLIENT")
        cli = .Cells(Rows.Count, 1).End(xlUp).Row
        .Cells(cli, 1).Resize(1, 5).Copy
    End With
    Sheets("Base").Cells(der, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Sheets("Base").Cells(der, 1).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Sheets("Cotation").Range("F10:F36").Copy
    Sheets("Base").Cells(der, 7).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    Sheets("Base").Cells(der, 7).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    Sheets("Cotation").Range("G10:G36").Copy
    Sheets("Base").Cells(der + 1, 7).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    Sheets("Base").Cells(der + 1, 7).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    Sheets("Base").Cells(der + 1, 6).Value = "Taux (%0)"
    Sheets("Cotation").Range("H10:H36").Copy
    Sheets("Base").Cells(der + 2, 7).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    Sheets("Base").Cells(der + 2, 7).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    Sheets("Base").Cells(der + 2, 6).Value = "Primes"
    Application.CutCopyMode = False
    Sheets("Base").Activate
    Sheets("Base").Cells(der, 1).Activate
End Sub

Bonne utilisation

Cordialement
Bonjour mon cher,
Merci pour tes solutions (codes) toujours parfaites.Mon problème est résolu. Merci encore 🙏🙏🙏
 
- 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
3
Affichages
128
Réponses
5
Affichages
488
Retour