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

我可以将工作表成功导入到我的工作簿中。 但是，有可能只是导入我想要的列？ 数据真的很大，我不想有麻烦去通过每个单元的一部分。 以下是我的代码：

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 

我在这里主要关心的是不知道“报告”工作表的布局。 .CurrentRegion的边界由第一个完全空白的列向右，第一个完全空白的行向下。 一个数据块很less有这个，但是工作表叫做Report 。

Answer 2

您正在closures刚刚打开的工作簿（没有保存或警告）复制后，所以我build议你循环通过你不想要的列，然后删除，然后复制。 将此片段合并到您现有的代码中

 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。 closures而不保存应保持原来的Report.xlsx不受影响。