некорректно работает скрипт

[Klerik97]

Доброго времени суток! Суть в том, что скрипт копирует данные из файла rod.xls, а не из открывшегося. Пересмотрел не один раз, вроде все правильно, помогите с проблемой. Код прилагается.(office 2003)

x = 0
Const myPattern = "*.XLS"
Dim myPath As String, myName As String, Wb As Workbook

myPath = CurDir & Application.PathSeparator
myName = Dir(myPath & myPattern, vbNormal + vbArchive)
Do While myName <> ""
Set Wb = Workbooks.Open(Filename:=myPath & myName _
, AddToMRU:=False)
x = x + 1

Wb.Activate
Range("H8").MergeArea.Copy
Windows("rod.xls").Activate
Cells(x, 1).Select
ActiveSheet.Paste

Wb.Close
myName = Dir ' Get next entry.
Loop


End Sub

[kuklp]

Правильно и копирует. Вы ему так задали. Хотите, чтоб копировало из открытой, строки:

Wb.Activate
Range("H8").MergeArea.Copy
Windows("rod.xls").Activate
Cells(x, 1).Select
ActiveSheet.Paste

замените на:

Wb.Activesheet.Range("H8").MergeArea.Copy workbooks("rod.xls").Activesheet.Cells(x, 1)

[Klerik97]

Сообщение от kuklp

Правильно и копирует. Вы ему так задали. Хотите, чтоб копировало из открытой, строки:

Wb.Activate
Range("H8").MergeArea.Copy
Windows("rod.xls").Activate
Cells(x, 1).Select
ActiveSheet.Paste

замените на:

Wb.Activesheet.Range("H8").MergeArea.Copy workbooks("rod.xls").Activesheet.Cells(x, 1)

Спасибо, помогло!