Excel 每一列都是一个单独的步骤。这太棒了！！！！！我完全明白了！！！！现在我想用它来删除工作表数据。我们正在导入的数据块也将（或可能被删除）。现在有一个宏用于此。而且工作非常快。我认为这很快，因为它只是在工作簿中删除了我列出的25张工作表。但是，我最初使用录制的

---

每一列都是一个单独的步骤。这太棒了！！！！！我完全明白了！！！！现在我想用它来删除工作表数据。我们正在导入的数据块也将（或可能被删除）。现在有一个宏用于此。而且工作非常快。我认为这很快，因为它只是在工作簿中删除了我列出的25张工作表。但是，我最初使用录制的宏来执行此操作。有几个SELECT语句和选择的ClearContent。我敢打赌，根据你给我看的，我也可以摆脱那些额外的SELECT语句。多谢各位！

    `Sub import_data()
    '
    ' import_data Macro
    Dim wb1 As Workbook

    Application.ScreenUpdating = False

    'Using FILE-OPEN text file and run thru text delimited setup

  Workbooks.OpenText (Module33.FileDir + "\cf_data.txt"), Origin:=437, _
  StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
  ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
  , Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), _
  Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1)), 
  TrailingMinusNumbers:=True

        'Applying the newly open excel workbook (text file)to a variable wb1
  Set wb1 = ThisWorkbook

         'Switching to the first sheet within this wb1 workbook
  With wb1.Sheets(1)

         'Selecting Columns A thru G and all rows in each columns that have 
          'values. text or numbers, no formulas.
  lr = .Range("A:G").Find(what:="*", after:=.Range("A1"), 
  searchorder:=xlByRows, _
  searchdirection:=xlPrevious).Row
  .Range(.Cells(2, "A"), .Cells(lr, "G")).Value          '<====Run-time 438 '- Object doesn't support this property or method

  End With

  wb1.Close SaveChanges:=False

        'Switches back to main workbook to sheet 2 then range B6 and paste 
        'all data

  Workbooks("Auto_Data.xlsm").Sheet2.Range("B6").Resize(UBound(arr, 
        1), UBound(arr, 2)) = arr


    'The code below does what I'm wanting however, it is very sluggish. This 
    'code, when in use, will sit just below text delimited section.

'    Range("A2:G2000").Select
'    Selection.Copy
'    Windows("Auto_Data.xlsm").Activate
'    Sheet2.Select
'    Range("B6:H6").Select
'    ActiveSheet.Paste
'    Selection.AutoFilter
'    Application.CutCopyMode = False
'    ActiveWindow.ActivateNext
'    ActiveWindow.Close
'    Range("B4").Select


Application.ScreenUpdating = True

End Sub

Option Explicit

Sub ImportData()
    Dim destWB As Workbook
    Set destWB = ThisWorkbook

    Dim textWB As Workbook
    Dim textWS As Worksheet
    Workbooks.OpenText "C:\Temp\testdata.txt", Space:=True
    Set textWB = ActiveWorkbook
    If textWB Is Nothing Then
        MsgBox "Unable to open the text data"
        Exit Sub
    Else
        Set textWS = textWB.Sheets(1)
    End If

    '--- determine the data range and copy to a memory-based array
    Dim lastRow As Long
    Dim lastCol As Long
    Dim textArea As Range
    Dim textData As Variant
    With textWS
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        Set textArea = .Range("A1").Resize(lastRow, lastCol)
        textData = textArea
    End With

    Dim destWS As Worksheet
    Dim destArea As Range
    Set destWS = destWB.Sheets("Sheet1")
    Set destArea = destWS.Range("A1").Resize(lastRow, lastCol)
    destArea = textData

    textWB.Close SaveChanges:=False
End Sub

Sub ImportData2()
    Dim destWB As Workbook
    Set destWB = ThisWorkbook

    Dim textWB As Workbook
    Dim textWS As Worksheet
    Workbooks.OpenText "C:\Temp\testdata.txt", Space:=True
    Set textWB = ActiveWorkbook
    If textWB Is Nothing Then
        MsgBox "Unable to open the text data"
        Exit Sub
    Else
        Set textWS = textWB.Sheets(1)
    End If

    Dim destWS As Worksheet
    Set destWS = destWB.Sheets("Sheet1")

    '--- first range to copy A2:A<lastRow> to destWS A2
    CopyData textWS, 1, 1, destWS, "A2"

    '--- second range to copy E2:E<lastRow> to destWS E2
    CopyData textWS, 5, 1, destWS, "E2"

    '--- third range to copy G2:J<lastRow> to destWS G2
    CopyData textWS, 7, 4, destWS, "G2"

    textWB.Close SaveChanges:=False
End Sub

Private Sub CopyData(ByRef srcWS As Worksheet, _
                     ByVal startColumn As Long, _
                     ByVal numberOfColumns As Long, _
                     ByRef destWS As Worksheet, _
                     ByVal destCell As String)
    Dim lastRow As Long
    Dim textArea As Range
    Dim textData As Variant
    With srcWS
        lastRow = .Cells(.Rows.Count, startColumn).End(xlUp).Row
        Set textArea = .Cells(2, startColumn).Resize(lastRow, numberOfColumns)
        textData = textArea
    End With

    Dim destArea As Range
    Set destArea = destWS.Range(destCell).Resize(textArea.Rows.Count, _
                                                 textArea.Columns.Count)
    destArea = textData
End Sub