Кавараный Excel!!! Глючит макрос сбора данных.

[mephist]

Уже как-то раз я поднимал этот вопрос, но теперь он возник с неожиданного ракурса.
Итак есть код:

Sub blank_fill_8()
    Application.Calculation = xlCalculationManual: On Error Resume Next
    Dim Sh As Worksheet
    For Each Sh In Sheets
        Sh.Unprotect
    Next
    Application.ScreenUpdating = False
    Filename = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, "sz.xlsx")
    With Workbooks.Open(Filename, , True)
        .Worksheets(1).Unprotect
        .Worksheets(1).Range("E9").Copy ThisWorkbook.Worksheets(1).[E9]
        .Worksheets(1).Range("E12:E13").Copy ThisWorkbook.Worksheets(1).[E12]
...
       .Close False
    End With
    Application.ScreenUpdating = False
    Filename = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, "hq.xlsx")
    With Workbooks.Open(Filename, , True)
    .Worksheets(1).Range("F9").Copy ThisWorkbook.Worksheets(1).[F9]
    ...
    End With
    Application.Calculation = xlCalculationAutomatic
End Sub

Смысловая нагрузка строки (как я понимаю,потому что писал не я):

Filename = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, "sz.xlsx")

В том,чтобы грузить файл sz из папки, в которую помещен текущий файл ThisWorkbook.
Вообще цель заключается в том,чтобы помещать этот текущий файл в разные папки, в которых есть точно определенное количество файлов, с известными именами книг и листов, но с разными данными.
Помещаем в одну папку. Запускаем макрос, в котором прописаны эти имена книг, листов и ячеек так, чтобы он подгрузил все эти данные в одну книгу. Сохраняем файл под другим именем. Переместили файл в другую папку. Подгрузили данные. Сохранили. Переместили.
Только вот проблема. Создал папку. Создал файлы-исходники и главный файл. Написал макрос. Данные действительно подгружаются из текущей папки главного файла. Но только именно для этих файлов исходников. Стоит лишь мне переместить главный файл в другую (аналогичную) папку или заменить один файл-исходник, все перестает работать. То есть откывается первый файл или тот файл, который был заменен и Excel завистает.
Итак вопрос: почему так поисходит??? Почему работает только один раз, а потом не работает??? Как такое может быть??? И что с этим делать???

[SAS888]

1. Зачем применяется строка

Filename = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, "sz.xlsx")

Считаю, лучше воспользоваться

Filename = ThisWorkbook.Path & "\sz.xlsx"

2. Если имена листов открываемых книг известны (т.е. не .Worksheets(1), а Sheets("Имя_листа")), то нет необходимости открывать файлы-источники.
3. Вам нужна именно копия ячеек (с форматами, формулами и т.п.),
или только их значения? Если копия (как у Вас в коде), то файл потребуется открывать и, как следствие, если скопировать ячейку, содержащую связь с другими ячейками (например, с формулой), то естественно, в дальнейшем, при перемещении файлов связи будут нарушаться и Excel будет в "легком замешательстве". Скорее всего у Вас проблема именно с этим. Если же нужны только значения, то см. пункт 2.
4. Вы говорите, что

есть точно определенное количество файлов, с известными именами книг и листов

, однако, описывая проблему, Вы заявляете, что

или заменить один файл-исходник

Что значит "заменить"?
5. Зачем "множить" один и тот же код? Сначала с именем "sz.xlsx", затем с "hq.xlsx" и т.д. Я так понимаю, что раз имена книг задаются в коде явно, то они известны заранее. Не лучше ли занести их в массив и организовать цикл?
6. Не понятно (видимо потому, что код приведен не полностью), зачем последовательно копировать данные из разных файлов в одни и те же ячейки?
7. Дайте пример 2-х - 3-х файлов источников с разными данными в ячейках для копирования, и объясните, что нужно сделать в Вашем "главном" файле. Я не вижу проблем сделать так, чтобы макрос не был привязан к исходным файлам и папкам. (желательно, в формате ".xls")

[mephist]

Огромное спасибо за оказанное внимание и подробный ответ.
итак по пунктам.
1) Прямо сейчас попобую

 
Filename = ThisWorkbook.Path & "\sz.xlsx"

2) писал номера листов, потому что было лень писать названия и на случай переименований. Хотя наверно теперь придет их обозначать.
3) Раньше я копирвал целиком, теперь буду дулать ссылки.
4) Замена происходит так: есть таблица, каждый пользователь заполняет только свою колонку раз в месяц, получется что пользователи дают мне одну и ту же таблицу, но в ней заполнена только по одной колонке (разной). Я ее собираю. В следуюшем месяце они мне опять дадут свои таблицы. Соответсвенно их таблицы-файлы исходники, моя таблица- "главный" файл. Я хочу заменять файлы исходники, а данные автоматически собиать в главном файле.
5) Полностью согласен. Уже сам начал переправлять. Просто я пошел от простого к сложному.
6) см пункт 4. Данные есть в файлах-исходниках только в одной колонке. А вообще номера ячеек в исходниках и "главном" совпадают.
7) а что можно сделать так, чтобы совсем не было привязок.
Сейчас буду по Вашим замечаниям отрбатывать такой код, если что-то не понял,можете сразу поправить

Sub blank_fill_8()
    Application.Calculation = xlCalculationManual: On Error Resume Next
    Dim Sh As Worksheet
    For Each Sh In Sheets
        Sh.Unprotect
    Next
    Application.ScreenUpdating = False
    Dim asFileNames, li As Long
    asFileNames = Array("sz.xlsx", "sd.xlsx", "mk.xlsx", "mp.xlsx")
    For li = LBound(asFileNames) To UBound(asFileNames)
    Filename = ThisWorkbook.Path & "\ asFileNames(li)"
    With Workbooks.Open(Filename, , True)
        .Worksheets(1).Unprotect
        .Worksheets(1).Range("E9").Copy ThisWorkbook.Worksheets(1).[E9]
        .Worksheets(1).Range("E12:E13").Copy ThisWorkbook.Worksheets(1).[E12]
...
       .Close False
Next li
 Application.Calculation = xlCalculationAutomatic
End Sub

[SAS888]

а что можно сделать так, чтобы совсем не было привязок.
Сейчас буду по Вашим замечаниям отрбатывать такой код, если что-то не понял, можете сразу поправить

С организацией цикла все нормально. А получать данные можно не открывая файл-источник. Но, как я уже говорил, нужно знать имя листа, из которого требуется получить данные. Так, пусть, например, во всех файлах-источниках имена листов с данными одинаковые "Лист1". Тогда можно так:

Sub blank_fill_8()
    Dim Sh As Worksheet, li As Long, asFileNames
    Dim p As String, f As String, s As String, a As String
    Application.Calculation = xlCalculationManual: Application.ScreenUpdating = False: On Error Resume Next
    asFileNames = Array("sz.xlsx", "sd.xlsx", "mk.xlsx", "mp.xlsx")
    For Each Sh In Sheets
        Sh.Unprotect
    Next
    ThisWorkbook.Sheets(1).Activate
    p = ThisWorkbook.path & Application.PathSeparator: s = "Лист1"
    For li = LBound(asFileNames) To UBound(asFileNames)
        f = asFileNames(li)
        a = [E9].Address: [E9] = GetValue(p, f, s, a)
        a = [E12].Address: [E12] = GetValue(p, f, s, a)
        a = [E13].Address: [E13] = GetValue(p, f, s, a)
            '''
            '''
    Next li
    Application.Calculation = xlCalculationAutomatic
End Sub

Function GetValue(path, file, sheet, ref)
    Dim arg As String
    arg = "'" & path & "[" & file & "]" & sheet & "'!" & Range(ref).Range("A1").Address(, , xlR1C1)
    GetValue = ExecuteExcel4Macro(arg)
End Function

Работоспособность кода проверьте сами (Вы же не прикрепили пример, а самому создавать во-первых, лень, во-вторых, обязательно сделаю что-нибудь не так).

[mephist]

Огромное спасибо. Файлики я как раз хотел выложить, но по ходу уже не надо. За код спасибо, сейчас попробую.

[mephist]

Файлы чисто для примера, но зато типичные. Можно сразу задать один уточняющий вопрос: Можно в цикле менять номера ячеек, котрые я копирую??? то есть из файла sz копируется например колонка В, из файла mp колонку C. Чтобы организовать все одним циклом нужно что-то навроде [&n%12], где для sz n=B, для mp n=C и т.д.

[mephist]

Очень надо организовать обозначение ячеек [&n%12], как можно организовать двумерный массив или несколько массивов значения из которых берутся зависимо, то есть из всех массивов берется первое значение, потом из всех второе и т.д??? И как [&n%12]???

[SAS888]

Можно в цикле менять номера ячеек, котрые я копирую??? то есть из файла sz копируется например колонка В, из файла mp колонку C.

Если столбцы идут последовательно, то можно, например, расположив имена файлов в массиве, согласно номерам столбцов, использовать переменную li (номер элемента массива). Так, например, строка

a = Cells(9, li + 2).Address: [E9] = GetValue(p, f, s, a)

вставит значение ячейки "B9" листа "Лист1" файла "sz.xlsx" в ячейку "E9" 1-го листа файла с макросом. В следующем проходе цикла, переменная li увеличится на 1. Значит данные будут взяты из следующего файлаи из следующего столбца.
Если же номера столбцов-источников произвольны, то организуйте второй массив той же размерности, что и asFileNames, в котором должны находиться номера столбцов на тех же позициях, что и имена файлов. Тогда по счетчику цикла из одного массива берем имя файла, а из другого - номер столбца в этом файле.

[mephist]

Да,да,да я это и имел ввиду. Лучше всего организовать второй массив, так как столбцы довольно произвольные, но как прописать счетчик? как организовать поэлементной выбор элементов массива? как подставить это значение в адрес ячейки? Вся проблема в том, что я не знаю
синтаксиса. Мне нужно перевести на синтаксис VBA:
m array (A,B,C,D,E)
[%m[i]%9]
i:=i+1;
И второй вопрос: можно в Вашем коде вместо присвоения значений записать ссылку? Это существенно изменит суть?

[SAS888]

1. Примерно так:

asFileNames = Array("sz.xlsx", "sd.xlsx", "mk.xlsx", "mp.xlsx")
asColumns = Array(1, 2, 3, 4)
p = ThisWorkbook.Path & Application.PathSeparator: s = "Лист1"
For li = LBound(asFileNames) To UBound(asFileNames)
    f = asFileNames(li)
    a = Cells(9, asColumns(li)).Address: [E9] = GetValue(p, f, s, a)
    a = Cells(12, asColumns(li)).Address: [E12] = GetValue(p, f, s, a)
    a = Cells(13, asColumns(li)).Address: [E13] = GetValue(p, f, s, a)
        '''
        '''
Next li

2.

можно в Вашем коде вместо присвоения значений записать ссылку? Это существенно изменит суть?

Можно. Но другим способом.