mixer 2 macros

francois31170

XLDnaute Nouveau
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
 

francois31170

XLDnaute Nouveau
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
 

Discussions similaires

Réponses
3
Affichages
184

Statistiques des forums

Discussions
312 493
Messages
2 088 952
Membres
103 989
dernier inscrit
jralonso