Excel-Makrohilfe - Stapeln von Makros

Question

Ich verwende die folgende Subroutine, um mehrere Excel-Dateien aus einem einzigen Ordner in einer einzigen Arbeitsmappe mit mehreren Arbeitsblättern zu kombinieren.

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 

Das Endprodukt ist eine Excel-Datei mit mehreren Arbeitsblättern (sowie einem leeren Blatt 1). Ich habe mich gefragt, wie ich dann ein weiteres Makro auf dieses neu erstellte Arbeitsbuch anwenden kann. Als ein Beispiel möchte ich, dass alle Arbeitsblätter in dieser neuen Arbeitsmappe ihre Kopfzeilen fett und auf eine bestimmte Weise koloriert haben und dass das leere Arbeitsblatt gelöscht wird.

zB:

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

einen Parameter Header hinzufügen, der ein Blatt gibt, dann die Unter ruft irgendwo in der Do-Schleife nach der Kopie, wie:

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

mit Ihrem zweiten Unter suchen dies wie:

Sub Headers(workingSheet As Worksheet) 

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

Answer 2

Dieser Code wird wie folgt vor:

Erste

1), löschen Sheet1 wie Sie in Ihrem Beitrag fragte

2) Formatieren Sie die obere Reihe in den verbleibenden Blätter

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