请尝试以下操作,将范围从一张纸复印到另一张。您可以将With wb.Worksheets(SheetName).Range("P9:X500")
分解为With wb.Worksheets(SheetName)
,然后在With语句中使用.Range("P9:X500").Copy this.Range("P9")
。避免使用像i或ii或这样的名称并使用更具描述性的内容。错误处理基本上只处理Sheets不存在,我认为可以更好地处理这种情况。最后,您需要重新打开ScreenUpdating以查看更改。
Sub GetDataDemo()
Const FileName As String = "Original.xlsx"
Const SheetName As String = "Original"
FilePath = "C:\Users\me\Desktop\"
Dim wb As Workbook
Dim this As Worksheet 'Please reconsider this name
Dim i As Long, ii As Long
Application.ScreenUpdating = False
If IsEmpty(Dir(FilePath & FileName)) Then
MsgBox "The file " & FileName & " was not found", , "File Doesn't Exist"
Else
Set this = ActiveSheet
Set wb = Workbooks.Open(FilePath & FileName)
With wb.Worksheets(SheetName)
'On Error Resume Next ''Not required here unless either of sheets do not exist
.Range("P9:X500").Copy this.Range("P9")
' On Error GoTo 0
End With
End If
ThisWorkbook.Worksheets("NEW").Activate
Application.ScreenUpdating = True ' so you can see the changes
End Sub
UPDATE:作为OP希望在两者上的列C片之间,以匹配并粘贴下面贴
2版跨越(山口p来山口X)第二代码版本相关联的行的信息:
Sub GetDataDemo()
Const FileName As String = "Original.xlsx"
Const SheetName As String = "Original"
FilePath = "C:\Users\me\Desktop\"
Dim wb As Workbook
Dim this As Worksheet 'Please reconsider this name
Dim i As Long, ii As Long
Set wb = ThisWorkbook
Set lookupRange = wb.Worksheets("Original").Range("C9:C500")
Set matchRange = wb.Worksheets("ThisSheet").Range("C9:C500")
Dim lookupCell As Range
Dim matchCell As Range
With wb.Worksheets("Original")
'Section that compares each cell value in lookup sheet "Original" col C and sees if there is a match in any of the rows in col C in "ThisSheet". Will be slow over larger numbers of rows.
For Each lookupCell In lookupRange
For Each matchCell In matchRange
If Not IsEmpty(matchCell) And matchCell = lookupCell Then 'assumes no gaps in lookup range
matchCell.Offset(0, 13).Resize(1, 9).Value2 = lookupCell.Offset(0, 13).Resize(1, 9).Value2
End If
Next matchCell
Next lookupCell
End With
ThisWorkbook.Worksheets("NEW").Activate
Application.ScreenUpdating = True ' so you can see the changes
End Sub
您可能需要修改几行以适合您的环境,例如将其更改为符合您的工作表名称(粘贴到)。
Set matchRange = wb.Worksheets("ThisSheet").Range("C9:C500")
你只是从一个范围复制到另一个表中的匹配范围? – QHarr
如果是这样的话:b.Worksheets(SheetName).Range(“P9:X500”)。复制this.Range(“P9”) – QHarr
是的,我但我想添加一个匹配(如果 - 那么我认为? )函数也会省略隐藏值。 – Blackfyre