vba 从其他工作簿导入单元格出错
vba import cells from other workbooks error
我正在尝试从其他工作簿复制一些单元格区域,但出现错误:
'runtime '1004' error
Error defined by application or object
如果我尝试使用 "range(cells(i,j), cells(k,h))" 语法而不是范围 ("A1:Z1")。即,在下面的代码中,行 "PASTE 1" 产生了一个错误,而行 "PASTE 2" 运行 很顺利(显然我不想使用第二个,因为我需要 运行 不同范围的循环)。
Sub Importa()
Dim directory As String
Dim fileName As String
Dim wbfrom As Workbook
Dim wbto As Workbook
Application.ScreenUpdating = False
Application.DisplayAlerts = False
directory = "mydirectory"
fileName = Dir(directory & "*.xl??") 'find the first *.xl?? file; ' wildcards: multiple character (*) single character (?)
Set wbto = ThisWorkbook
Set wbfrom = Workbooks.Open(directory & fileName, False, True)
' copy some cells
wbfrom.Sheets(1).Range(Cells(9, 6), Cells(15, 6)).Copy
'PASTE 1
wbto.Sheets(1).Range(Cells(9, 1), Cells(15, 1)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'PASTE 2
'wbto.Sheets(1).Range("A1:A8").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wbfrom.Close SaveChanges:=False
'Turn on screen updating and displaying alerts again
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
问题是您需要将 Cells
限定为特定的 sheet/workbook。否则,它隐式属于 ActiveSheet
,并且由于 wbFrom
在 运行 时处于活动状态,因此该范围不能存在(因为一个工作表上的单元格不能在另一个工作表上定义范围)
有两种处理方法,一种是排位赛 Cells
,如下所示:
With wbto.Sheets(1)
.Range(.Cells(9, 1), .Cells(15, 1)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End With
另一种是从单元格强制地址:
wbto.Sheets(1).Range(Cells(9, 1).Address, Cells(15, 1).Address).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
我更喜欢第一个选项,因为它往往更动态,并且如果需要的话,以后更容易阅读和修改。
我正在尝试从其他工作簿复制一些单元格区域,但出现错误:
'runtime '1004' error
Error defined by application or object
如果我尝试使用 "range(cells(i,j), cells(k,h))" 语法而不是范围 ("A1:Z1")。即,在下面的代码中,行 "PASTE 1" 产生了一个错误,而行 "PASTE 2" 运行 很顺利(显然我不想使用第二个,因为我需要 运行 不同范围的循环)。
Sub Importa()
Dim directory As String
Dim fileName As String
Dim wbfrom As Workbook
Dim wbto As Workbook
Application.ScreenUpdating = False
Application.DisplayAlerts = False
directory = "mydirectory"
fileName = Dir(directory & "*.xl??") 'find the first *.xl?? file; ' wildcards: multiple character (*) single character (?)
Set wbto = ThisWorkbook
Set wbfrom = Workbooks.Open(directory & fileName, False, True)
' copy some cells
wbfrom.Sheets(1).Range(Cells(9, 6), Cells(15, 6)).Copy
'PASTE 1
wbto.Sheets(1).Range(Cells(9, 1), Cells(15, 1)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'PASTE 2
'wbto.Sheets(1).Range("A1:A8").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wbfrom.Close SaveChanges:=False
'Turn on screen updating and displaying alerts again
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
问题是您需要将 Cells
限定为特定的 sheet/workbook。否则,它隐式属于 ActiveSheet
,并且由于 wbFrom
在 运行 时处于活动状态,因此该范围不能存在(因为一个工作表上的单元格不能在另一个工作表上定义范围)
有两种处理方法,一种是排位赛 Cells
,如下所示:
With wbto.Sheets(1)
.Range(.Cells(9, 1), .Cells(15, 1)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End With
另一种是从单元格强制地址:
wbto.Sheets(1).Range(Cells(9, 1).Address, Cells(15, 1).Address).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
我更喜欢第一个选项,因为它往往更动态,并且如果需要的话,以后更容易阅读和修改。