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

F

francois31170

Guest
Bonjour

J'ai 2 macros que j'aimerais mixer.
L'objectif de ces macros est de fusionner plusieurs onglets.

MACRO 1 me plait car elle nomme les onglets à fusionner
MACRO 2 me plait car elle correspond exactement à ce que je veux, excepté le fait qu'elle ne liste pas les onglets concernés par l'opération.
MACRO 1 :
Sub recap()
Dim nSh&, nCol&, shList
shList = Array("AA", "BB", "CC", "DD")
nCol = Sheets(shList(0)).[A1].End(xlToRight).Column
ActiveWorkbook.Worksheets.Add Before:=ActiveWorkbook.Sheets(1)
Sheets(shList(0)).[A1].Resize(1, nCol).Copy Destination:=ActiveSheet.[A1]
For nSh = 0 To UBound(shList)
With Sheets(shList(nSh))
.[A1].Resize(.Cells(.Cells(.Rows.Count, 1).End(xlUp).Row - 1, 1).Row, nCol).Offset(1, 0).Copy _
Destination:=[A1].Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
End With
Next
End Sub

MACRO 2 :
Sub FUSION()
Sheets("base").[A1].CurrentRegion.Offset(1, 0).Clear
For s = 4 To 8
nlig = Sheets(s).[A65000].End(xlUp).Row - 1
nCol = Sheets(s).[A1].CurrentRegion.Columns.Count
[A65000].End(xlUp).Offset(1, 0).Resize(nlig, nCol).Value = _
Sheets(s).[A2].Resize(nlig, nCol).Value
Next s
On Error Resume Next
[A:A].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub


J'ai essayé de mixer les 2 (bref récupérer le listage précis des onglets à récupérer et l'intégrer dans la macro 2), mais ca ne marche pas.

Si quelqu'un avait la gentillesse de m'aider ?

En vous remerciant

Francois
 
Re : mixer 2 macros

Je crois que j'ai réussi :

Option Explicit

Sub recap()
Dim o As Worksheet
Set o = Worksheets("Base")
o.[A1].CurrentRegion.Offset(1, 0).Clear
Dim nSh&, nCol&, shList
shList = Array("A", "B", "C", "D")
nCol = Sheets(shList(0)).[A1].End(xlToRight).Column
Sheets(shList(0)).[A1].Resize(1, nCol).Copy Destination:=o.[A1]
For nSh = 0 To UBound(shList)
With Sheets(shList(nSh))
.[A1].Resize(.Cells(.Cells(.Rows.Count, 1).End(xlUp).Row - 1, 1).Row, nCol).Offset(1, 0).Copy _
Destination:=o.[A1].Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
End With
Next
End Sub
 
- 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
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

Réponses
15
Affichages
782
Réponses
5
Affichages
909
Retour