Здравствуйте, уважаемые форумчане, подскажите пожалуйста, как можно решить следующий вопрос, написан макрос, он на отдельный лист (отчет) вставляет ячейки путем открывания и закрывания файлов и копирования из них данных. То есть, если файлов 100 штук, то на компьютере пользователя поочереди открываются 100 окон и он видит постоянное моргание окон, можно ли как-то скрыть открывание окон скрыть от пользователя?

вот макрос

Sub ShowFolderList(folderspec)
Dim fs, f, f1, fc, s, sh
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
Set fc = f.Files
Regim = Worksheets("Serv").Cells(1, 5).Value
Worksheets("Report").Range("A5:AA300").Select
' Range("AA34").Activate
Selection.ClearContents
i = 4
For Each f1 In fc
s = ""
s = s & folderspec & "\"
s = s & f1.Name
Workbooks.Open Filename:=s, ReadOnly:=True, editable:=False
WName = ActiveWorkbook.Name

incl = Worksheets("Serv").Cells(1, 5).Value
If incl = Regim Then
i = i + 1
Sheets("Problem").Select
Range("A2:R2").Select
Selection.Copy
Windows("Claims_Report.xls").Activate
Field = "A" & i
Sheets(1).Range(Field).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells(i, 19).Value = s

End If
' Workbooks(WName).Close

Workbooks(WName).Close False


Next
End Sub





Заранее спасибо

Shocker.Pro

Скажите пожалуйста, в какое именно место эту команду вставить?

martinezoShocker.Pro

Скажите пожалуйста, в какое именно место эту команду вставить?

вставил сюда:

Sub ShowFolderList(folderspec)
Dim fs, f, f1, fc, s, sh
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
Set fc = f.Files
Regim = Worksheets("Serv").Cells(1, 5).Value
Worksheets("Report").Range("A5:AA300").Select
' Range("AA34").Activate
Selection.ClearContents
i = 4
For Each f1 In fc
s = ""
s = s & folderspec & "\"
s = s & f1.Name
Workbooks.Open Filename:=s, ReadOnly:=True, editable:=False
Application.ScreenUpdating = False
WName = ActiveWorkbook.Name

incl = Worksheets("Serv").Cells(1, 5).Value
If incl = Regim Then
i = i + 1
Sheets("Problem").Select
Range("A4:R4").Select
Selection.Copy
Windows("Claims_Report.xls").Activate
Field = "A" & i
Sheets(1).Range(Field).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells(i, 19).Value = s

End If
' Workbooks(WName).Close

'Application.DisplayAlerts = False
Workbooks(WName).Close False



Next
End Sub

вроде как работает, но потом выходит такая ошибка: Прекращена работа файла майкрософт ексель - Перезапустить программу, и программа вылетает (см. скрин)

Shocker.Proэ-эх, плохо все...

в конце надо

А еще уже пора бы научиться пользоваться тэгами оформления кода

сделал как Вы сказали, (вот макрос):
Sub ShowFolderList(folderspec)
Dim fs, f, f1, fc, s, sh
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
Set fc = f.Files
Regim = Worksheets("Serv").Cells(1, 5).Value
Worksheets("Report").Range("A5:AA300").Select
' Range("AA34").Activate
Selection.ClearContents
i = 4
For Each f1 In fc
s = ""
s = s & folderspec & "\"
s = s & f1.Name
Workbooks.Open Filename:=s, ReadOnly:=True, editable:=False
Application.ScreenUpdating = False WName = ActiveWorkbook.Name

incl = Worksheets("Serv").Cells(1, 5).Value
If incl = Regim Then
i = i + 1
Sheets("Problem").Select
Range("A2:R2").Select
Selection.Copy
Windows("Claims_Report.xls").Activate
Field = "A" & i
Sheets(1).Range(Field).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells(i, 19).Value = s

End If
Workbooks(WName).Close False

Next
Application.DisplayAlerts = True
End Sub


после этого все равно вылетает ексель, выходит ошибка Прекращена работа файла майкрософт ексель - Перезапустить программу, и программа вылетает (см. скрин)

товарищи, может кто-то знает как решить вопрос того, что вылетает "Эксель"

Спасибо.