您将在下面找到用于将选定文件的范围导入活动工作簿的代码。宏被分配给活动工作簿上的一个按钮。
我想将范围("U2:AH2")粘贴在活动工作表的行上,其中单元格T2的值(单元格T2在打开的文件中)与活动工作表中表D列中的值相匹配。
Sub Import_QTN_Data()
Dim FileToOpen As Variant
Dim OpenBook As Workbook
Application.ScreenUpdating = False
FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*),*xls*")
If FileToOpen <> False Then
Set OpenBook = Application.Workbooks.Open(FileToOpen)
OpenBook.Worksheets("QUOTATION").Range("U2:AH2").Copy
ThisWorkbook.Worksheets("QUOTATION").Range("E30").PasteSpecial xlPasteValues, skipblanks:=True
OpenBook.Close False
End If
Application.ScreenUpdating = True
End Sub
您可以使用Match()
或Find()
。下面是使用Match()
Sub Import_QTN_Data()
Dim FileToOpen As Variant
Dim OpenBook As Workbook, wsQuote As Worksheet, m
Application.ScreenUpdating = False
FileToOpen = Application.GetOpenFilename( _
Title:="Browse for your File & Import Range", _
FileFilter:="Excel Files (*.xls*),*xls*")
If FileToOpen <> False Then
Set wsQuote = ThisWorkbook.Worksheets("QUOTATION")
Set OpenBook = Application.Workbooks.Open(FileToOpen)
With OpenBook.Worksheets("QUOTATION")
'use Match() on ColD
m = Application.Match(.Range("T2").Value, wsQuote.Columns("D"), 0)
If Not IsError(m) Then 'got a match (`m` is not an error value)
.Range("U2:AH2").Copy
wsQuote.Cells(m, "E").PasteSpecial xlPasteValues, skipblanks:=True
End If
End With
OpenBook.Close False
End If
Application.ScreenUpdating = True
End Sub