我有一个主宏工作簿,其唯一目的是运行一个循环遍历特定文件夹中所有工作簿的宏,进行一系列更改,然后将它们保存到另一个文件夹中。
除了一些新代码我想循环遍历所有不同的工作表之外,所有这些都有效。代码只是一遍又一遍地在第一个工作表上运行代码。
Sub BlendBCoding()
Dim Filename, Pathname As String
Dim wb As Workbook
Dim ws As Worksheet
Dim NameOfWorkbook
Dim cel As Variant
Dim myrange As Range
Pathname = ActiveWorkbook.Path & "\ToProcess\"
Filename = Dir(Pathname & "*.xml")
Do While Filename <> ""
Set wb = Workbooks.Open(Pathname & Filename)
For Each ws In wb.Sheets
Call DoWork(ws)
Next
NameOfWorkbook = Left(ActiveWorkbook.Name, (InStrRev(ActiveWorkbook.Name, ".", -1, vbTextCompare) - 1))
ActiveWorkbook.SaveAs Filename:= _
"I:\Common\BlendBCoding\Processed\" & NameOfWorkbook & ".xlsx", FileFormat _
:=xlOpenXMLWorkbook, CreateBackup:=False
wb.Close SaveChanges:=False
Filename = Dir()
Loop
End Sub
Sub DoWork(ws As Worksheet)
With ws
Range("A1:G1").EntireColumn.Insert
Range("A1").Value = "Scan Components"
Range("A1").ColumnWidth = 16
//Blah Blah lots of standard text code cut
Set myrange = Range("H1:H100")
myrange.Interior.ColorIndex = xlNone
For Each cel In myrange
If Application.WorksheetFunction.CountIf(myrange, cel) > 1 Then
cel.Interior.ColorIndex = 4
End If
Next
'Set myrange = Range("H2:H25")
'For Each xCell In myrange
' xCell.Value = CDec(xCell.Value)
' Next xCell
End With
End Sub
非常感谢任何帮助。
答案 0 :(得分:2)
您未指向ws
事先使用.
,否则您将引用ActiveSheet
。
With ws
.Range("A1:G1").EntireColumn.Insert
.Range("A1").Value = "Scan Components"
.Range("A1").ColumnWidth = 16
//Blah Blah lots of standard text code cut
Set myrange = .Range("H1:H100")
myrange.Interior.ColorIndex = xlNone
For Each cel In myrange
If Application.WorksheetFunction.CountIf(myrange, cel) > 1 Then
cel.Interior.ColorIndex = 4
End If
Next
End With