从其他工作表导入范围



您将在下面找到用于将选定文件的范围导入活动工作簿的代码。宏被分配给活动工作簿上的一个按钮。

我想将范围("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

最新更新