2015-03-12 8 views
0

У меня есть мастер-макросъемка, предназначенная для запуска макроса, который обрабатывает все рабочие книги в определенной папке, производит кучу изменений и затем сохраняет их в другая папка.Excel VBA для прокрутки рабочих листов в серии рабочих книг

Все это работает, за исключением некоторого нового кода, где я хочу прокручивать все разные рабочие листы. Код просто продолжает работу с кодом на первом листе снова и снова.

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 

Любая помощь очень ценится.

ответ

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 
+0

Благодарим вас. Я думал, что пытался, но должен был иметь другие проблемы в то время. – swaggers

+0

Пожалуйста, отметьте как ответ, если он сработает для вас, приветствует. –

Смежные вопросы