With Workbooks.Open(MyFiles & s)
' To copy file
Set wb = Workbooks.Open(MyFiles & s)
ну тут явно что-то лишнее... Код проверил - если файл есть, то нормально открывается, окно не серое. Если конечно этот файл не сохранён с скрытым окном! А может он остался в таком виде открытым после предыдущих экспериментов с getobject()?
Скрытое окно - это когда меню вид - окно - скрыть! Если в коде использовали getobject() - то файл открывается в таком виде. Если файл там же и сохранили - значит в таком виде и сохранили. Если не закрыли - ну значит он в таком виде и открыт. Так что надёжнее перезагрузить.
Если открываете файл вручную - что с фоном? Стоп, это ведь VBE (не вижу нифига уже в таких картинках...) - а почему это Вас волнует? Зачем оно нужно? У меня всё ОК, похоже что у Вас глюк. Может что с офисом...
Hugo,Даже когда удалаи с 17 по 38 строки, чтобы только выделял ячейку и сохранял при закрытии. Быстро проверить цикл. Тоже самое серый фон. Но другие макросы работают.
Если уж Вы так упорно применяете всюду селекты, то не нужно забывать и про активацию:
Код
' To insert file
ThisWorkbook.Activate
ThisWorkbook.Worksheets("Лист2").Select
У Вас ведь в этот момент активна открытая книга! А вообще уходите от селектов и активаций, пишите код без них. Как - см. форумы или книги. Лучше форумы
Hugo,29 строку как активировать после thisworkbook.Activate ? Ведь остается активированной только Thisworkbook, а надо переключиться. Workbooks.Open(MyFiles & s).Activate не подойдет ведь.
Вообще т.к. копируете только значения, то весь этот код можно сократить раз так в 10. Сейчас... Вот, лишнее закомментил. Кстати, у меня открывает и xlsx, и xlsm...
Код
Sub KopirovanieIVstavkaVSpisok()
Dim s As String, MyFiles As String ', MyRange As String, MyRange2 As String, wb As Workbook
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.AskToUpdateLinks = False
MyFiles = "C:\Users\User\Desktop\Papka3\"
s = Dir(MyFiles & "*.xls")
Do While s <> ""
With Workbooks.Open(MyFiles & s)
' To copy file
il = ThisWorkbook.Worksheets("Лист2").Cells.SpecialCells(xlCellTypeLastCell).Row + 1
ThisWorkbook.Worksheets("Лист2").Cells(il, 1) = .ActiveSheet.Cells(1, 4)
' Range("D1").Select ' .Worksheets("Лист1").
' Selection.Copy
' ' To insert file
' ThisWorkbook.Activate
' ThisWorkbook.Worksheets("Лист2").Select
' MyRange = "A" & ThisWorkbook.Worksheets("Лист2").Cells.SpecialCells(xlCellTypeLastCell).Row + 1
' ThisWorkbook.Worksheets("Лист2").Range(MyRange).Select
' Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
' :=False, Transpose:=False
il = il + 1
ThisWorkbook.Worksheets("Лист2").Cells(il, 2) = .ActiveSheet.Cells(8, 7)
' ' To copy file
' Set wb = Workbooks.Open(MyFiles & s)
' Range("G8").Select ' .Worksheets("Лист1").
' Selection.Copy
'
' ' To insert file
' ThisWorkbook.Activate
' ThisWorkbook.Worksheets("Лист2").Select
' MyRange2 = "B" & ThisWorkbook.Worksheets("Лист2").Cells.SpecialCells(xlCellTypeLastCell).Row + 1
' ThisWorkbook.Worksheets("Лист2").Range(MyRange2).Select
' Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
' :=False, Transpose:=False
.Close 0 '!!!! SaveChanges:=True
End With
s = Dir
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.AskToUpdateLinks = True
End Sub
Я делал как Вы код написали, как он работал (должен был работать) так и мой работает! Опоздали Вы с описанием, теперь всё Сами разбирайтесь какую одну строку нужно убрать.
А на картинке, внизу, - активен Excel. М.б. всё же VBA?
Далее. В строке 16 кода вы берете и копируете значение не из Лист1, а из активного листа книги, из которой запускаете макрос. Но Вы же хотите копировать из только что открытой книги. Всё проверить нет возможности, но вот такой код - будет правильнее Вашего. Чтобы каждый раз не писать ThisWorkbook.Worksheets("Лист2"), лучше объявить переменную и присвоить ей этот объект. Я применил переменную Sh
Код
Sub KopirovanieIVstavkaVSpisok()
Dim s As String, MyFiles As String, MyRange As String, MyRange2 As String, wb As Workbook, sh As Worksheet
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.AskToUpdateLinks = False
Set sh = ThisWorkbook.Worksheets("Лист2")
MyFiles = "C:\Users\User\Desktop\Papka3\"
s = Dir(MyFiles & "*.xls")
Do While s <> ""
Set wb = Workbooks.Open(MyFiles & s)
With wb
' To copy file
.Worksheets("Лист1").Range("D1").Copy
' To insert file
sh.Select
MyRange = "A" & sh.Cells.SpecialCells(xlCellTypeLastCell).Row + 1
sh.Range(MyRange).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
' To copy file
' Set wb = Workbooks.Open(MyFiles & s)
.Worksheets("Лист1").Range("G8").Copy
' To insert file
sh.Select
MyRange2 = "B" & sh.Cells.SpecialCells(xlCellTypeLastCell).Row + 1
' sh.Range(MyRange2).Select
' Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
' :=False, Transpose:=False
sh.Range(MyRange).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
.Close SaveChanges:=True
End With
s = Dir
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.AskToUpdateLinks = True
End Sub
Всё сложное - не нужно. Всё нужное - просто /М. Т. Калашников/
Visual Basic Editor Tutorial for Excel - How to use the VBE
Цитата
Михаил Лебедев написал: В строке 16 кода вы берете и копируете значение не из Лист1, а из активного листа книги, из которой запускаете макрос.
- если это мне, то ошибаетесь. Про переменную согласен, чуть короче. P.S. А Ваш код не взлетел - ну нет вдруг в открываемом файле .Worksheets("Лист1")...