從一個工作簿提取數據並將其複製到另一個工作簿

Question

我試圖將數據從一個工作簿複製到另一個工作簿。

我通過互聯網搜索，並提出了下面的代碼。代碼中沒有錯誤。

代碼工作正常，但問題是，它打開兩個表，但不復制目標工作表中的數據。

在下面的代碼中，我認爲x是源表單，y是目標表單。

有人可能會建議，我錯了什麼，我不能複製的原因是什麼。

Sub test() 
Dim x As Workbook 
Dim y As Workbook 
Dim val As Variant 
Dim filename As String 


Set x = Workbooks.Open("D:\Mikz\xxx.xlsx") 

Set y = Sheets("Sheet1").Select 
val = x.Sheets("Sheet2").Range("A1").Value 
y.Sheets("Sheet1").Range("A1").Value = val 

x.Close 

End Sub 

Answer 1

嘗試：

Sub test() 
Dim wb As Workbook 
Dim sht As Worksheet, sht2 As Worksheet 

Set wb = Workbooks.Open("Filename") 
Set sht = wb.Worksheets("Sheet2") 
Set sht2 = ThisWorkbook.Worksheets("Sheet1") 

sht2.Range("A1").Value = sht.Range("A1").Value 

wb.Close 
End Sub 

但它應該拋出語法錯誤和之前類型不匹配。不要使用.Select，它不需要任何功能或任務，它可以不用。

Answer 2

原因你的錯誤，在於以下部分：

Dim y As Workbook 
Set y = Sheets("Sheet1").Select 

您定義y爲工作簿，但試圖將Worksheet對象分配給它，您添加Select出於某種原因，這是挑釁不推薦。

它應該是（如果工作簿是打開的）：

Set y = Workbooks("YourBookName") 

你的代碼的其餘部分會工作得很好。

---

---

然而，讀您的文章，我覺得你的意思來定義y As Worksheet。

然後你的代碼的其餘部分應該是：

Set y = Sheets("Sheet1") 
val = x.Sheets("Sheet2").Range("A1").Value 
y.Range("A1").Value = val 

---

編輯1：更新後的代碼（根據PO的新數據）

Option Explicit 

Sub test() 

Dim x As Workbook 
Dim y As Workbook 
Dim Val As Variant 
Dim filename As String 

Set y = ThisWorkbook ' set ThisWorkbook object (where this code lies) 
Set x = Workbooks.Open("D:\Mikz\xxx.xlsx") 

Val = x.Sheets("Sheet2").Range("A1").Value 
y.Sheets("Sheet1").Range("A1").Value = Val 

x.Close 

End Sub 

---

編輯2：代碼複製列A：E直到最後一行有數據

Option Explicit 

Sub test() 

Dim x As Workbook 
Dim y As Workbook 
Dim Val As Variant 
Dim filename As String 
Dim LastCell As Range 
Dim LastRow As Long 

Set y = ThisWorkbook ' set ThisWorkbook object (where this code lies) 
Set x = Workbooks.Open("D:\Mikz\xxx.xlsx")  
With x.Sheets("Sheet2") 
    ' use the find method to get the last row in column A:E 
    Set LastCell = .Columns("A:E").Find(What:="*", After:=.Cells(1), Lookat:=xlPart, LookIn:=xlFormulas, _ 
          SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False) 
    If Not LastCell Is Nothing Then ' find was successful 
     LastRow = LastCell.Row ' get last Row with data 
    End If 

    Val = .Range("A1:E" & LastRow).Value ' save range in 2-D array 
End With 

' resize the range from A1 through column E and the last row with data in copied workbook 
y.Sheets("Sheet1").Range("A1").Resize(LastRow, 5).Value = Val 

x.Close 

End Sub