Question

我的代码旨在导入用户选择的.xls文件，并将其复制并粘贴到Book 1中的数据表中。本书1有2张：结果和数据。

我想在结果中运行代码，这就是问题所在。当我在数据表中运行它时，清除当前工作表（数据）后，文件将被导入并复制好。

但是，当我在结果表中导入它时，根据MsgBox Err.Description出现错误代码中有什么问题？

Sub ImportData()

Dim customerBook As Workbook
Dim filter As String
Dim caption As String
Dim customerFilename As String
Dim customerWorkbook As Workbook
Dim targetWorkbook As Workbook
Dim wb As Workbook

On Error Resume Next

Set wb = Application.Workbooks("Book1.xlsm")
wb.Activate
wb.Sheets("Data").Range("A1:M5000").Select
Selection.ClearContents
Sheets("Data").Select
Range("A1").Select

Set targetWorkbook = Application.ActiveWorkbook

filter = "Text files (*.xls),*.xls"
caption = "Please Select an Input File "
customerFilename = Application.GetOpenFilename(filter, , caption)

Set customerWorkbook = Application.Workbooks.Open(customerFilename)

Dim targetSheet As Worksheet
Set targetSheet = targetWorkbook.ActiveSheet
Dim sourceSheet As Worksheet
Set sourceSheet = customerWorkbook.ActiveSheet

sourceSheet.UsedRange.Copy targetSheet.Range("A1")
sourceSheet.UsedRange.Value = sourceSheet.UsedRange.Value
targetSheet.Paste

customerWorkbook.Saved = True
customerWorkbook.Close

Sheets("Results").Select

End Sub

Answer 1

以下代码：

wb.Sheets("Data").Range("A1:M5000").Select
Selection.ClearContents

应替换为：

wb.Sheets("Data").Range("A1:M5000").ClearContents

所有类似的线也是如此。选择操作最常来自宏录制器，是一种非常不可靠和缓慢的方法。它依赖于当前选择的范围或对象，并且在代码中不透明，因为它强制知道当前选择/活动的内容。

选择只应在宏操作结束时保持选定的工作表或单元格处于活动状态或在ActiveWindow上执行操作。

同样，尝试消除ActiveSheet：

Set targetSheet = targetWorkbook.ActiveSheet

并将其替换为以下示例之一：

Set targetSheet = targetWorkbook.Worksheets(1) '1st worksheet in the file
Set targetSheet = targetWorkbook.Worksheets("myData") 'worksheet named "myData"

Answer 2

你可以这样试试......

Sub ImportData()
Dim filter As String
Dim caption As String
Dim customerFilename As Variant
Dim customerWorkbook As Workbook, targetWorkbook As Workbook
Dim targetSheet As Worksheet, sourceSheet As Worksheet

Set targetWorkbook = Application.Workbooks("Book1.xlsm")
Set targetSheet = targetWorkbook.Sheets("Data")
targetSheet.Range("A1:M5000").ClearContents

filter = "Text files (*.xls),*.xls"
caption = "Please Select an Input File "
customerFilename = Application.GetOpenFilename(filter, , caption)

If customerFilename = False Then
    MsgBox "No Customer File was selected.", vbExclamation
    Exit Sub
End If
Set customerWorkbook = Application.Workbooks.Open(customerFilename)

Set sourceSheet = customerWorkbook.ActiveSheet

sourceSheet.UsedRange.Copy
targetSheet.Range("A1").PasteSpecial xlPasteValues

Application.CutCopyMode = 0

sourceSheet.UsedRange.Value = sourceSheet.UsedRange.Value

customerWorkbook.Saved = True
customerWorkbook.Close

targetWorkbook.Sheets("Results").Select

End Sub

错误选择范围类失败的方法

2 个答案: