如何导入具有所需列的工作表？ Excel VBA

Question

我能够成功地将工作表导入我的工作簿。但是可以只导入我想要的列吗？数据非常庞大，我不想麻烦地遍历细胞的每个部分。 以下是我的代码：

Sub ImportSheet()
    Dim wb As Workbook
    Dim activeWB As Workbook
    Dim sheet As Worksheet
    Dim FilePath As String
    Dim oWS      As String
    Set activeWB = Application.ActiveWorkbook

    FilePath = "C:\Report.xlsx"

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Set wb = Application.Workbooks.Open(FilePath)
    wb.Sheets("Report").Copy After:=activeWB.Sheets(activeWB.Sheets.Count)
    activeWB.Activate
    wb.Close False
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

End Sub

Answer 1

不确定我是否在这里违反了协议，但这是一种完全不同的方法，并且有添加另一个答案的选项。此方法使用“复制到新工作表” 方法，在有限的资源上应该更容易。

Sub ImportSheet()
    Dim iWB As Workbook, aWB As Workbook, ws As Worksheet
    Dim FilePath As String, v As Long, vCOLs As Variant

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    FilePath = "C:\Report.xlsx"
    vCOLs = Array(1, 13, 6, 18, 4, 2) 'columns to copy in this order

    Set aWB = Application.ActiveWorkbook
    With aWB
        .Sheets.Add after:=.Sheets(.Sheets.Count)
        Set ws = .Sheets(.Sheets.Count)
        '.name = "Report"   'you can name the new ws but do NOT duplicate
    End With
    Set iWB = Application.Workbooks.Open(FilePath)
    With iWB.Sheets("Report").Cells(1, 1).CurrentRegion
        .Cells = .Cells.Value
        For v = LBound(vCOLs) To UBound(vCOLs)
            .Columns(vCOLs(v)).Copy Destination:=ws.Cells(1, v + 1)
        Next v
    End With
    iWB.Close False

    Set iWB = Nothing
    Set ws = Nothing
    Set aWB = Nothing

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

我主要关心的是不知道'Report' 工作表的布局。 .CurrentRegion 的边界由右侧第一个完全空白的列和向下的第一个完全空白行决定。数据块很少有这种情况，但称为 Report 的工作表经常会这样做。

Answer 2

复制后您将关闭新打开的工作簿（不保存或警告），因此我建议您循环浏览您不想要的列并在复制之前删除。将此 sn-p 合并到您现有的代码中

Dim v As Long, vNoCopy As Variant, wb As Workbook
vNoCopy = Array(1, 3, 5, 7)   'should in ascending order (reversed below)
With wb.Sheets("Report")
    .Cells = .Cells.Value   'just in case there are referenced formulas involved
    For v = UBound(vNoCopy) To LBound(vNoCopy) Step -1
        .Columns(vNoCopy(v)).EntireColumn.Delete
    Next v
    wb.Sheets("Report").Copy After:=activeWB.Sheets(activeWB.Sheets.Count)
End With
wb.Close False

这应该在复制之前从报告中删除 A、C、E 和 G 列。关闭而不保存应该不会影响原始 Report.xlsx。