从一个工作簿中提取数据并复制到另一个工作簿

我正试图将数据从一个工作簿复制到另一个工作簿。

我通过互联网search，并提出了下面的代码。 代码中没有错误。

代码工作正常，但问题是，它打开两个表，但不复制目标工作表中的数据。

在下面的代码中，我将x视为源表单，将y视为目标表单。

有人可能会build议，我错了，我不能复制的原因是什么。

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

您错误的原因在于以下部分：

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

您将y定义为工作簿，但是尝试将Worksheet对象分配给该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 

Answer 2

尝试：

 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 

但是它应该抛出语法错误，并input不匹配。 不要使用。select，它不是任何function或任务所必需的，它可以没有。