Ошибка при вставлении копированного текста в новый хлс фаил

[shkipper]

Всем привет.

Название этого топика само о себе говорит.

Значит в цикле, когда я пытаюсь вставить копированный текст в другой фаил, я получаю ошибку.
Может кто нибудь увидит что именно я пропустил? Так как я уже и не знаю из за чего это может быть.

Sub auto_close()

Dim linkSrcFile As String
Dim targetSrcFile As String

Dim currentFilePath As String

Dim wkbLink As Workbook
Dim targetWkb As Workbook

Dim wksLinkWkb As Worksheet 'Link document
Dim wksCurrent As Worksheet 'Current
Dim targetWks As Worksheet 'Target = Results

'Dim currentWks As Worksheet
Dim docname As String
Dim user As String

'File names
Dim linkDoc As String
Dim resultDoc As String

linkDoc = "Link document.xls"
resultDoc = "Results.xls"

'On Error GoTo ErrorHandling

'Set Paths
linkSrcFile = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, linkDoc)
targetSrcFile = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, resultDoc)

'Get workbooks
Set wkbLink = GetObject(linkSrcFile)
Set targetWkb = GetObject(targetSrcFile)

'Get worksheets
Set wksLinkWkb = wkbLink.Worksheets("Sheet1")
Set wksCurrent = ThisWorkbook.Worksheets("Sheet1")
Set targetWks = targetWkb.Worksheets("Sheet1")

Dim nbColumns As Integer
Dim nbForUnhiddenColumn As Integer

'Determing the amount of columns
nbColumns = Range("1:1").Cells.SpecialCells(xlCellTypeConstants).Count

'Checking for unhidden column
For i = 1 To nbColumns
    If Columns(i).Hidden = False Then
        Debug.Print "Column is not hidden"
        nbForUnhiddenColumn = i
        Exit For
    End If
Next i

'First row
'wksCurrent.Range("A1", "P1").Copy
wksCurrent.Range(Cells(1, 1), Cells(1, 16)).Copy
targetWks.Range("A1", "P1").PasteSpecial (xlPasteAll)
targetWks.Range("Q1").Value = "User"

'Looping thru the records in Link xls file
For i = 2 To wksLinkWkb.Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count

    docname = wksLinkWkb.Cells(i, 3).Value
    user = wksLinkWkb.Cells(i, 2).Value

        'Looping thru Report.xls records
        For j = 2 To wksCurrent.Range(nbForUnhiddenColumn & ":" & nbForUnhiddenColumn).Cells.SpecialCells(xlCellTypeConstants).Count
            If wksCurrent.Cells(j, "J").Value = docname Then
                Debug.Print "Match " & docname & " " & user
                wksCurrent.Range(Cells(j, 1), Cells(j, nbColumns)).Copy
                targetWks.Range(Cells(i, 1), Cells(i, nbColumns)).PasteSpecial (xlPasteAll)
                targetWks.Cells(i, nbColumns + 1).Value = user
                Exit For
            End If
        Next j
Next i

targetWkb.Save
targetWkb.Close
wkbLink.Close False
Debug.Print "Target workbook saved and closed"

Exit_thisSub:
    Exit Sub

ErrorHandling:
    Dim strMsg As String
    Select Case Err.Number
        Case 432
            strMsg = "Error occured: Make sure the names of the files are correct: " & linkDoc & " and " & resultDoc & " and they are in the same map, as this one (" & ThisWorkbook.Name & ")"
            MsgBox strMsg
            targetWkb.Close False
            wkbLink.Close False
        Case Else
            strMsg = "Error occured: " & Err.Number & " " & Err.Description
            MsgBox strMsg
            targetWkb.Close False
            wkbLink.Close False
    End Select
    Exit Sub

End Sub

[shkipper]

даже если я убераю эту ошибку, ну тоесть при помощи
targetWks.activate
wksCurrent.activate

тогда я не получаю ошибки НО тогда хлс фаил куда я копирую получается пустой, там даже пустых табов нет
не знаю в чем проблема

[Казанский]

'Determing the amount of columns
nbColumns = Range("1:1").Cells.SpecialCells(xlCellTypeConstants).Count

'Checking for unhidden column
For i = 1 To nbColumns
    If Columns(i).Hidden = False Then

Какая книга в этот момент активна, после GetObject'ов?

Поставьте точку останова на первом исполняемом операторе да пройдите по шагам (F8). Наблюдайте за значениями переменных в окне Locals или наводя курсор на переменную.

[shkipper]

Хмм но ведь это не проблема.
Это просто мне дает номер не спрятанной колонки и все.

Тоесть в моем примере это будет 1, вот и все.

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

[doober]

У вас четко не определены листы,поэтому работа идет на активном в этот момент листе

nbColumns = Worksheets("Неизвестный").Range("1: 1").Cells.SpecialCells(xlCellTypeCo nstants).Count

'Checking for unhidden column
For i = 1 To nbColumns
If Worksheets("Неизвестный2").Columns( i).Hidden = False Then

[shkipper]

Верно

Я это изменил, спасибо!

Но все та же проблема у меня не получается копировать.
И очень странно если я просто запускаю макро все нормально проходит если я пошагово иду то он выдает ошибку в цикле мол не получается селекцию сделать для того что бы потом туда вставить.

Ужс, запарился уже 2 дня сижу и не в еду ... что же не так.

[doober]

А если так копировать

 wksCurrent.Range(Cells(1, 1), Cells(1, 16)).Copy  argetWks.Range("A1", "P1")
targetWks.Range("Q1").Value = "User"

For i = 2 To wksLinkWkb.Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count

    docname = wksLinkWkb.Cells(i, 3).Value
    user = wksLinkWkb.Cells(i, 2).Value

        'Looping thru Report.xls records
        For j = 2 To wksCurrent.Range(nbForUnhiddenColumn & ":" & nbForUnhiddenColumn).Cells.SpecialCells(xlCellTypeConstants).Count
            If wksCurrent.Cells(j, "J").Value = docname Then
                Debug.Print "Match " & docname & " " & user
                wksCurrent.Range(Cells(j, 1), Cells(j, nbColumns)).Copy targetWks.Range(Cells(i, 1), Cells(i, nbColumns))
                targetWks.Cells(i, nbColumns + 1).Value = user
                Exit For
            End If
        Next j
Next i

[Hugo121]

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

Может быть всё копируется правильно, но копируются пустые ячейки? И такое бывало...

[shkipper]

Возможно вы и правы

Но у меня есть эти файлы

щас попытаюс их как то загрузить

Вот вложил, в архиве 3 файла, в одном есть макро, другой просто линк, а в резулт идет результат

Благодарю за помощь, особенно те кто найдет похему скрипт не работает

[doober]

файл какой то дерганый.
проверяйте