I am using the following subroutine to combine multiple Excel files from a single folder into a single workbook with multiple worksheets.
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.Wo开发者_运维知识库rksheets(wbDst.Worksheets.Count)
wbSrc.Close False
strFilename = Dir()
Loop
wbDst.Worksheets(1).Delete
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
The end product is an excel file with multiple worksheets (as well as one blank Sheet 1). I was wondering how I can then apply another macro to this newly created Workbook. As an example, I wish for all the worksheets within this new workbook to have their Headers bold and coloured a certain way, and to have the empty Worksheet deleted.
eg:
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
Sheets.Select 'selects all sheets'
Rows("1:1").Select
Selection.Interior.ColorIndex = 37
Add a parameter to Headers that specifies a sheet, then call the sub somewhere in the Do Loop after the copy, like:
Call Headers(wbDst.Worksheets(wbDst.Worksheets.Count))
with your second sub looking like this:
Sub Headers(workingSheet As Worksheet)
workingSheet.Rows("1:1").Select
Selection.Font.Bold = True
With Selection.Interior
.
.
.
This code will do the following:
1) First, delete Sheet1
as you asked for in your post
2) Format the top row in the remaining sheets
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
精彩评论