После копирования и вставки целевого файла xls нет листов

Question

У меня есть код, который копирует запись по записи и вставляет ее в целевой файл xls, который изначально пуст. Он имеет как недавно созданный файл xls, 3 пустых листа.

Я сделал некоторые корректировки и начал получать ошибку.

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

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

Answer 1

Я не являюсь мастером в VBA, но у меня есть опыт работы от 2 до 3 месяцев, и я могу помочь вам импровизировать ваш код, учитывая линию на линии. Я не знаю о других версиях Excel, но работаю в 2003 году.

Иногда я обнаруживал ошибки времени выполнения, используя только книгу. Я не понимал причину, поэтому я решил использовать Excel.Workbook

  Dim wkbLink As Workbook, make it as Dim wkbLink As Excel.Workbook Instead 

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

Set wkbLink = GetObject(linkSrcFile)        ' I have no idea about this but
Set wkbLink = workbooks.open(linksSrcFile)  ' It works perfect.

Set targetWks = targetWkb.Worksheets("Sheet1")  ' right way 
Set targetWks = targetWkb.Worksheets(1) 'Can also refer to sheet 1 like these   

Чтобы найти количество столбцов

nbColumns = Range("1:1").Cells.SpecialCells(xlCellTypeConstants).Count ' No idea

Используйте эти

Columnz = Thisworkbook.workSheets(1).Cells(1, Columns.Count).End(xlToLeft).Column
else
Thisworkbook.worksheets(1).activate
Columnz = Activesheet.Cells(1, Columns.Count).End(xlToLeft).Column

Я не вижу, на каком листе вы ссылаетесь, чтобы найти количество столбцов, его сложно выяснить, попробуйте сослаться на объект.

и

If Columns(i).Hidden = False Then   'make it as below
if activesheet.columns(i).Entirecolumn.Hidden= false then 

Это не эти

wksCurrent.Range("A1", "P1").Copy  ' its wrong make it like below
wksCurrent.Range("A1:P1").Copy  

Я не понимаю, что вы пытаетесь сделать, но я верю, что вы пытаетесь скопировать строку из A1: P1 на другой лист, и вы должны сделать это так

   wbk_1.sheets(1).range("A1:P1").copy
   wbk_2.sheets(1).activate
   activesheet.range("A1").select
   activesheet.paste ' now_wbk_2.sheets(1) has copied row in its first row

Возможно, вы используете их, чтобы найти количество строк

 wksLinkWkb.Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count 

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

 Rowz = Thisworkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row ' to count no of rows    

Я только что ответил за режимы копирования и вставки, попробуйте прочитать мой ответ, он поможет вам Как я могу копировать между двумя открытыми экземплярами Excel в VBA?

Больше помощи. спроси меня, я тебе помогу. Спасибо