浏览并从另一个工作簿导入数据

Question

我需要从另一个有数千行的工作簿导入数据。

这是我当前正在使用的代码。我希望通过使用 Dim Lastrow 作为 Long 来使其动态。但是，代码不起作用，而是仅复制了 W2 的第一行。

Private Sub CommandButton1_Click()
    Dim FileToOpen As Variant
    Dim openbook As Workbook
    Dim lastrow As Long
    Application.ScreenUpdating = False
    
    lastrow = Cells(Rows.Count, "W").End(xlUp).Row
    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.Sheets("Sheet1").Range("W2:AA" & lastrow).Copy
        ThisWorkbook.Worksheets("REPORT").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        openbook.Close False
    End If
    Application.ScreenUpdating = True
End Sub

Answer 1

从关闭的工作簿复制值

Private Sub CommandButton1_Click()
    
    ' Source
    
    Dim sFilePath As Variant: sFilePath = Application.GetOpenFilename( _
        Title:="Browse for your File & Import Range", _
        Filefilter:="Excel Files (*xls*),*xls*")
    If sFilePath = False Then Exit Sub
    
    Application.ScreenUpdating = False
    
    Dim swb As Workbook: Set swb = Workbooks.Open(sFilePath)
    Dim sws As Worksheet: Set sws = swb.Sheets("Sheet1")
    Dim srg As Range:
    Set srg = sws.Range("AA2", sws.Cells(sws.Rows.Count, "W").End(xlUp))
        
    ' Destination
    
    Dim dwb As Workbook: Set dwb = ThisWorkbook ' workbook containing this code
    Dim dws As Worksheet: Set dws = dwb.Sheets("REPORT")
    
    Dim drg As Range
    
    With dws.Cells(dws.Rows.Count, "A").End(xlUp).Offset(1)
        Set drg = .Resize(srg.Rows.Count, srg.Columns.Count)
    End With
    
    'Debug.Print "Copying " & srg.Address(0, 0) & " to " & drg.Address(0, 0)
    
    ' Copy values...
    
    drg.Value = srg.Value
    swb.Close SaveChanges:=False
    'dwb.Save
    
    Application.ScreenUpdating = True

End Sub