0
我有通過記錄複製記錄並將其粘貼到目標xls文件中的代碼，最初爲空。它有一個新創建的xls文件，3個空頁。複製並粘貼目標xls文件沒有工作表
我做了一些調整，我開始出現錯誤。
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沒有任何表。