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

[SAS888]

Все требуемые ссылки можно прописывать и макросом ( например, при открытии). Затем, можно (если нужно) удалить ссылки, оставив в ячейках значения, полученные по ссылке.
И если, при формировании ссылки, использовать ThisWorkbook.Path, то проблем с папками точно не будет.

[valerij]

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

использовать ThisWorkbook.Path, .

Сергей, объясни мне, извините, что влез, у меня сейчас так

For dat = 1 To 31
    Filename = "F:\Заявки\2009\Июль\На " & Format(dat, "00") & ".07.09.xls"
       With Workbooks.Open(Filename, , True)

А как мне применить ThisWorkbook.Path, так?

For dat = 1 To 31
    Filename = ThisWorkbook.Path & "\На " & Format(dat, "00") & ".07.09.xls"
      With Workbooks.Open(Filename, , True)

[SAS888]

А как мне применить ThisWorkbook.Path

Да. Так. Можно было и самостоятельно попробовать и проверить.

[valerij]

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

Да. Так. Можно было и самостоятельно попробовать и проверить.

Попробовал, заполняет одними нулями, вот код полный

Sub test4()
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    For dat = 1 To 31
    Filename = ThisWorkbook.Path & "\На " & Format(dat, "00") & ".07.09.xls"
     If Dir(Filename) = "" Then GoTo 1    ' такого файла нет
    With Workbooks.Open(Filename, , True)
        For nn = 3 To 35
            ThisWorkbook.Worksheets(1).Cells(nn, dat + 1) = Worksheets(3).Cells(nn, 2)
        Next
       .Close False: GoTo 2
1:      For vv = 3 To 35
            ThisWorkbook.Worksheets(1).Cells(vv, dat + 1) = 0
        Next
2:    End With
    Next
Application.EnableEvents = True
End Sub

[SAS888]

С открытием и закрытием файла все должно быть нормально. А вот все остальное...
Во-первых, без необходимости не следует использовать GoTo.
Во-вторых, без необходимости не следует использовать циклы.
В-третьих, переменные нужно объявлять.
Ну, в общем, примерно так:

Sub test4()
    Dim dat As Long, nn As Long, Filename As String, wb As Workbook
    Application.EnableEvents = False: Application.ScreenUpdating = False
    For dat = 1 To 31
        Filename = ThisWorkbook.Path & "\На " & Format(dat, "00") & ".07.09.xls"
        With ThisWorkbook.Sheets(1)
            If Dir(Filename) = "" Then
                .Range(.Cells(3, dat + 1), .Cells(35, dat + 1)) = 0
            Else
                Workbooks.Open Filename:=Filename
                Sheets(3).[B3:B35].Copy: .Cells(3, dat + 1).PasteSpecial Paste:=xlPasteValues
                ActiveWorkbook.Close False
            End If
        End With
    Next
    Application.EnableEvents = True
End Sub

[valerij]

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

А вот все остальное...

Все разобрался, основной файл, лежал не в том месте!
Сергей.
Спасибо!

[SAS888]

Попробуйте после строки

Filename = ThisWorkbook.Path & "\На " & Format(dat, "00") & ".07.09.xls"

вставить

MsgBox Filename

и посмотрите, правильно ли формируются путь и имя файла для открытия и есть ли такой файл.
Если вопросы еще будут - рекомендую открыть новую тему.

[mephist]

В завершении той темы, что начинал еще я. Все коды работали. Проблема была с файлами-исходниками из которых я копировал данные. Там была установлена внешняя связь с файлом, именно она и мешалась.
Можете мне что-нибудь посоветовать, чтобы обезопасить себя от таких неприятностей в будущем??? Можно при открытии файла исходника, обрубить все его связи, сохраняя последнее значение? И можно ли игнорить ошибки и неверные ссылки?
Всем большое спасибо.

[SAS888]

Если нужно при открытии книги предотвратить запрос на обновление связей и разорвать все связи (удалить ссылки), оставив значения, то вставьте в модуль "Эта книга" код:

Private Sub Workbook_Open()
    With ActiveWorkbook
        .UpdateLinks = xlUpdateLinksNever
        a = .LinkSources(xlExcelLinks)
        If Not IsEmpty(a) Then
            For i = 1 To UBound(a): .BreakLink Name:=a(i), Type:=xlExcelLinks: Next
        End If
    End With
End Sub

[mephist]

Спасибо большое SAS888.
Мне приходила мысль взять и перевести все данные в значения кодом:

   With Workbooks.Open(Filename, , , , , , True)      
       Dim Sh As Worksheet
       For Each Sh In Sheets
           Sh.Unprotect
       Next
   End With

Не сомневаюсь, что Ваш код лучше(и использовать я буду именно его),но я хочу начать понимать коды, поэтому можно несколько вопросиков:
1) Что функционально мой код не учитывает по сравнению с Вашим?
2) А при выполнении Вашего кода, будут меняться файлы исходники(то есть их нужно открывать на "IgnoreReadOnlyRecomended" или можно "ReadOnly"(предпочтительнее))?
3) Я не очень понимаю

вставьте в модуль "Эта книга"

Мой макрос сохранен в книге, в которую собираются данные. Если я верно понимаю, то Ваш код нужно будет вставить в самый конец моего(после End Sub)??? И он будет срабатывать каждый раз, как только открывается книга в основном коде???
Если все так то получается код(может быть будут рекомендации):

Sub Макрос5()
    Dim Sh As Worksheet, li As Long, asFileNames, asColumns1, asLiners4, asColumns8, asColumns10a, asColumns10b
    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("hq.xlsx", "sz.xlsx", "sd.xlsx", "mk.xlsx", "mp.xlsx", "mc.xlsx", "ug.xlsx", "mn.xlsx", "mh.xlsx")
    asColumns1 = Array(6, 5, 7, 8, 9, 10, 11, 12, 13)
    asLiners4 = Array(13, 11, 12, 16, 18, 14, 19, 15, 17)
    asColumns8 = Array(7, 12, 17, 22, 27, 32, 37, 42, 47)
    asColumns10a = Array(1, 6, 10, 18, 22, 14, 26, 30, 34)
    asColumns10b = Array(5, 4, 6, 7, 8, 9, 10, 11, 12)
    For Each Sh In Sheets
        Sh.Unprotect
    Next
    For li = LBound(asFileNames) To UBound(asFileNames)
        Filename = ThisWorkbook.Path & \asFileNames(li)
        With Workbooks.Open(Filename, , True)
        ThisWorkbook.Sheets("8.1_Ñâîäíûå äàííûå ïî ÎÑ").Cells(9, asColumns1(li)).Formula = "=" & .Sheets("8.1_Ñâîäíûå äàííûå ïî ÎÑ").Cells(9, asColumns1(li)).Address(, , , True)
(30 штук таких же строк)
With ThisWorkbook.Worksheets(11).UsedRange: N = .Row + .Rows.Count - 1: End With
        Application.ScreenUpdating = False
            .Worksheets(11).UsedRange.Copy ThisWorkbook.Worksheets(11).Cells(N + 1, "A")
            For i = 1 To 8
                ThisWorkbook.Worksheets(11).Rows(N + 1).Delete Shift:=xlUp
            Next
            With ThisWorkbook.Worksheets(11).UsedRange: N = .Row + .Rows.Count - 1: End With
            For i = 1 To 6
            ThisWorkbook.Worksheets(11).Rows(N - 5).Delete Shift:=xlUp
            Next
            
            With ThisWorkbook.Worksheets(13).UsedRange: N = .Row + .Rows.Count - 1: End With
            Application.ScreenUpdating = False
                .Worksheets(13).UsedRange.Copy ThisWorkbook.Worksheets(13).Cells(N + 1, "A")
            For i = 1 To 10
                 ThisWorkbook.Worksheets(13).Rows(N + 1).Delete Shift:=xlUp
            Next
        .Close False
        End With
    Next li
    With ThisWorkbook.Worksheets(11).UsedRange: N = .Row + .Rows.Count - 1: End With
    ThisWorkbook.Worksheets(11).Cells(N - 5, "C").FormulaR1C1 = "=SUM(R9C3:R[-1]C)"
    With ThisWorkbook.Worksheets(13).UsedRange: N = .Row + .Rows.Count - 1: End With
    ThisWorkbook.Worksheets(13).Cells(N + 1, "B").FormulaR1C1 = "=SUM(R11C2:R[-1]C)"
    Application.Calculation = xlCalculationAutomatic
End Sub
Private Sub Workbook_Open()
    With ActiveWorkbook
        .UpdateLinks = xlUpdateLinksNever
        a = .LinkSources(xlExcelLinks)
        If Not IsEmpty(a) Then
            For i = 1 To UBound(a): .BreakLink Name:=a(i), Type:=xlExcelLinks: Next
        End If
    End With
End Sub