2015-09-07 2 views
1

Кто-нибудь, пожалуйста, помогите мне. Я получаю ошибку, когда он входит в цикл while. Смотрите ниже код (первый файл работает правильно hoever, когда он входит ошибка цикла будет генерировать.)Тип ошибки ошибки во время цикла

ActiveSheet.Range("A:E").AutoFilter Field:=1, Criteria1:= _ 
     "=*CHASE RETURN DATE*", Operator:=xlAnd 

Полный код ниже:.

Option Explicit 

Sub CombineTextFiles() 
    Dim FilesToOpen 
    Dim x As Integer 
    Dim wkbAll As Workbook 
    Dim wkbTemp As Workbook 
    Dim sDelimiter As String 
    Dim erow 
    Dim IRow As Long 

    On Error GoTo ErrHandler 
    Application.ScreenUpdating = False 

    sDelimiter = "|" 

    FilesToOpen = Application.GetOpenFilename _ 
     (FileFilter:="Text Files (*.txt), *.txt", _ 
     MultiSelect:=True, Title:="Text Files to Open") 

    If TypeName(FilesToOpen) = "Boolean" Then 
     MsgBox "No Files were selected" 
     GoTo ExitHandler 
    End If 

    x = 1 
    Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x)) 
    wkbTemp.Sheets(1).Copy 
    Set wkbAll = ActiveWorkbook 
    wkbTemp.Close (False) 
    wkbAll.Worksheets(x).Columns("A:A").TextToColumns _ 
     Destination:=Range("A1"), DataType:=xlFixedWidth, _ 
     FieldInfo:=Array(Array(0, 2), Array(47, 2), Array(72, 2), Array(93, 2), Array(103, 2)) _ 
     , TrailingMinusNumbers:=True 
     Cells.Select 
    Selection.AutoFilter 
    ActiveSheet.Range("A:E").AutoFilter Field:=2, Criteria1:="=*$*", _ 
     Operator:=xlAnd 
     ActiveSheet.UsedRange.Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy 
Workbooks("Test.xlsm").Activate 
Sheets("Sheet1").Select 
erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row 
ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(erow, 1), Cells(erow, 4)) 
'To pick the date 
wkbAll.Worksheets(x).Activate 
Selection.AutoFilter 
ActiveSheet.Range("A:E").AutoFilter Field:=1, Criteria1:= _ 
     "=*CHASE RETURN DATE*", Operator:=xlAnd 
With ActiveSheet.UsedRange.Columns(4).Offset(1, 0).Resize(Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible).Select 
End With 
Selection.Copy 
Workbooks("Test.xlsm").Activate 
Sheets("Sheet1").Select 
erow = Sheet1.Cells(Rows.Count, 6).End(xlUp).Offset(1, 0).Row 
ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(erow, 6), Cells(erow, 6)) 

'Sum Amount 
wkbAll.Worksheets(x).Activate 
Selection.AutoFilter 
ActiveSheet.Range("A:E").AutoFilter Field:=3, Criteria1:= _ 
     "=*$*", Operator:=xlAnd 
With ActiveSheet.UsedRange.Columns(3).Offset(1, 0).Resize(Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible).Select 
End With 
Selection.Copy 
Workbooks("Test.xlsm").Activate 
Sheets("Sheet1").Select 
erow = Sheet1.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row 
ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(erow, 2), Cells(erow, 2)) 

    x = x + 1 

    While x <= UBound(FilesToOpen) 
     Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x)) 
     With wkbAll 
      wkbTemp.Sheets(1).Move After:=.Sheets(.Sheets.Count) 
      .Worksheets(x).Columns("A:A").TextToColumns _ 
       Destination:=Range("A1"), DataType:=xlFixedWidth, _ 
     FieldInfo:=Array(Array(0, 2), Array(47, 2), Array(72, 2), Array(93, 2), Array(103, 2)) _ 
     , TrailingMinusNumbers:=True 
     Cells.Select 
    Selection.AutoFilter 
    ActiveSheet.Range("A:E").AutoFilter Field:=2, Criteria1:="=*$*", _ 
     Operator:=xlAnd 
     ActiveSheet.UsedRange.Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy 
Workbooks("Test.xlsm").Activate 
Sheets("Sheet1").Select 
erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(2, 0).Row 
ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(erow, 1), Cells(erow, 4)) 
Workbooks(Worksheets(x)).Activate 
Selection.AutoFilter 
ActiveSheet.Range("A:E").AutoFilter Field:=1, Criteria1:= _ 
     "=*CHASE RETURN DATE*", Operator:=xlAnd ' This is where I'm getting error as "Type missmatch" 
     End With 
     x = x + 1 
    Wend 

ExitHandler: 
    Application.ScreenUpdating = True 
    Set wkbAll = Nothing 
    Set wkbTemp = Nothing 
    Exit Sub 

ErrHandler: 
    MsgBox Err.Description 
    Resume ExitHandler 
End Sub 
+0

++ для усилий и исследований в вопрос, и указав соответствующую строку (но вы должны начать отступы ваш код лучше, чтобы сделать его проще для других, чтобы прочитать - попытаться сделать хороший отчетливый разделы с вертикальными пространствами и использовать вложенный отступ) –

ответ

0

Я забыл добавить переменную как wkball перед активация рабочего листа. К сожалению моя ошибка

wkbAll.Worksheets(x).Activate 
+0

хорошая работа! не забудьте принять свой ответ завтра :) –

Смежные вопросы