Copier une partie de code dans ThisWorkook

[MJ13]

Bonjour à tous

J'ai ce code qui permet de copier l'intégralité du code de Thisworkbook dans le classeur actif. Mais je voudrais copier que de la ligne 16 par exemple à la fin. Mais, je n'y arrive pas 😕🙁. J'ai mis des ' sur le code qui me pose problème.

Merci d'avance 🙂.

Sub AjouterCode()
'Stop
Dim iajcode As Byte
nomact = ThisWorkbook.Name '"fichier1.xls"
nomact2 = ActiveWorkbook.Name '"Fichier2.xls"
iajcode = Workbooks(nomact).VBProject.VBComponents("Thisworkbook").CodeModule.CountOfLines
'For iajcode2 = 16 To iajcode
Workbooks(nomact2).VBProject.VBComponents("Thisworkbook").CodeModule.AddFromString Workbooks(nomact).VBProject.VBComponents("Thisworkbook").CodeModule.Lines(1, iajcode)
'Next
End Sub

 

[tototiti2008]

Re : Copier une partie de code dans ThisWorkook

Bonjour Michel 🙂,

Peut-être (pas testé)

For iajcode2 = 16 To iajcode
Workbooks(nomact2).VBProject.VBComponents("Thisworkbook").CodeModule.AddFromString   Workbooks(nomact).VBProject.VBComponents("Thisworkbook").CodeModule.Lines(iajcode2,1)
Next

 

[Pierrot93]

Re : Copier une partie de code dans ThisWorkook

Bonjour Michel🙂, Toto🙂

une autre proposition non testée, si j'ai bien compris ton souci, pas sûr....

Option Explicit
Sub test()
Dim wbs As Workbook, wbd As Workbook, v As Object
Set wbs = Workbooks("Source.xls")
Set wbd = Workbooks("Destination.xls")
Set v = wbs.VBProject.VBComponents("ThisWorkbook")
With wbs.VBProject
    If v.CodeModule.CountOfLines > 0 Then
        With wbd.VBProject.VBComponents(v.CodeModule).CodeModule
            .DeleteLines 1, .CountOfLines
            .InsertLines .CountOfLines + 1, v.CodeModule.Lines(16, v.CodeModule.CountOfLines)
        End With
    End If
End With
End Sub

bon après midi
@+

 

[MJ13]

Re : Copier une partie de code dans ThisWorkook

Bonjour Tototiti, Pierrot

Merci pour ta réponse 🙂.

Désolé, mais cela ne fonctionne pas. Cela me copie des lignes, mais pas les bonnes😕.

Merci Pierrot, je teste un peu plus tard 😱.

 

[MJ13]

Re : Copier une partie de code dans ThisWorkook

Re

Merci beaucoup Pierrot cela fonctionne parfaitement. Juste remplacer ThisWorkbooks par ThisWorkbook.

Cela vaut bien un like un code de cette qualité 😱. Allez, un like d'encouragement quand même pour Tototiti 😱.

Merci et bonne après-midi 🙂.

 

[Pierrot93]

Re : Copier une partie de code dans ThisWorkook

Re,

Juste remplacer ThisWorkbooks par ThisWorkbook.

bien vu Michel, j'ai éditer mon code.