Aide de la macro Excel - Empilage des macros

Question

J'utilise la sous-routine suivante pour combiner plusieurs fichiers Excel d'un seul dossier dans un seul classeur avec plusieurs feuilles de calcul.

Sub Merge2MultiSheets() 

Dim wbDst As Workbook 
Dim wbSrc As Workbook 
Dim wsSrc As Worksheet 
Dim MyPath As String 
Dim strFilename As String 

Application.DisplayAlerts = False 
Application.EnableEvents = False 
Application.ScreenUpdating = False 
MyPath = "C:\MyPath" ' <-- Insert Absolute Folder Location 
Set wbDst = Workbooks.Add(xlWBATWorksheet) 
strFilename = Dir(MyPath & "\*.xls", vbNormal) 

If Len(strFilename) = 0 Then Exit Sub 

Do Until strFilename = ""    
    Set wbSrc = Workbooks.Open(Filename:=MyPath & "\" & strFilename)     
    Set wsSrc = wbSrc.Worksheets(1)     
    wsSrc.Copy After:=wbDst.Worksheets(wbDst.Worksheets.Count)     
    wbSrc.Close False    
    strFilename = Dir()    
Loop 
wbDst.Worksheets(1).Delete 

Application.DisplayAlerts = True 
Application.EnableEvents = True 
Application.ScreenUpdating = True 

End Sub 

Le produit final est un fichier Excel contenant plusieurs feuilles de calcul (ainsi qu'une feuille 1 vierge). Je me demandais comment puis-je appliquer une autre macro à ce cahier nouvellement créé. Par exemple, je souhaite que toutes les feuilles de calcul de ce nouveau classeur aient leurs en-têtes en gras et en couleur d'une certaine manière, et que la feuille de calcul vide soit supprimée.

par exemple:

Sub Headers() 

Rows("1:1").Select 
Selection.Font.Bold = True 
With Selection.Interior 
    .ColorIndex = 37 
    .Pattern = xlSolid 
End With 
Selection.Borders(xlDiagonalDown).LineStyle = xlNone 
Selection.Borders(xlDiagonalUp).LineStyle = xlNone 
With Selection.Borders(xlEdgeLeft) 
    .LineStyle = xlContinuous 
    .Weight = xlThin 
    .ColorIndex = xlAutomatic 
End With 
With Selection.Borders(xlEdgeTop) 
    .LineStyle = xlContinuous 
    .Weight = xlThin 
    .ColorIndex = xlAutomatic 
End With 
With Selection.Borders(xlEdgeBottom) 
    .LineStyle = xlContinuous 
    .Weight = xlThin 
    .ColorIndex = xlAutomatic 
End With 
With Selection.Borders(xlEdgeRight) 
    .LineStyle = xlContinuous 
    .Weight = xlThin 
    .ColorIndex = xlAutomatic 
End With 
With Selection.Borders(xlInsideVertical) 
    .LineStyle = xlContinuous 
    .Weight = xlThin 
    .ColorIndex = xlAutomatic 
End With 

End Sub 

Answer 1

Ajouter un paramètre à en-têtes qui spécifie une feuille, puis appeler le sous quelque part dans la boucle Do après la copie, comme:

Call Headers(wbDst.Worksheets(wbDst.Worksheets.Count)) 

avec votre deuxième sous la recherche comme ceci:

Sub Headers(workingSheet As Worksheet) 

workingSheet.Rows("1:1").Select 
Selection.Font.Bold = True 
With Selection.Interior 
. 
. 
. 

Answer 2

ce code va effectuer les opérations suivantes:

1) Tout d'abord, supprimer Sheet1 que vous avez demandé dans votre post

2) Formater la rangée supérieure dans les feuilles restantes

Sub Headers() 
Dim wkSheet As Worksheet 

//Delete Sheet1. Note that alerts are turned off otherwise you are prompted with a dialog box to check you want to delete sheet1 
Application.DisplayAlerts = False 
Worksheets("Sheet1").Delete 
Application.DisplayAlerts = False 

//Loop through each worksheet in workbook sheet collection 
For Each wkSheet In ActiveWorkbook.Worksheets 
    With wkSheet.Rows("1:1") 
     .Interior.ColorIndex = 37 
     //Add additional formatting requirements here 
    End With 
Next 

End Sub 

Answer 3

Sheets.Select  'selects all sheets' 
Rows("1:1").Select 
Selection.Interior.ColorIndex = 37