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

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

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

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

但它之前应抛出语法错误和类型不匹配。不要使用.Select，它不是任何函数或任务所必需的，它可以不用。

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

2 个答案: