error again

[Rafael Alvares Tubero]

Hello everybody,

Guys, I was trying to run this code with a error treatment, but what happen it is failing when it goes through the second error treatment, it's just stop to run. Let me show you, the line where it's failing is in red:

Sub I8()
Dim i As Long
Dim n As String
Dim n1 As String
Dim MyName As String
Dim MyFile As Variant
Dim MyFile1 As Variant
'Dim dir As String
'Dim arq As String
'Dim arq1 As String
Dim ult_col As Long
Dim ult_lin As Long
Dim absoluto As Long

MyName = ThisWorkbook.Name
dir = Range("dir")
arq = Range("arq")
arq1 = Range("arq1")
n = Sheets("Feriados").Range("I8")
n1 = Sheets("Feriados").Range("I9")

Workbooks(MyName).Activate
Sheets("OnShoreA").Select
Columns("A:AN").ClearContents
Workbooks(MyName).Activate
Sheets("OnShoreB").Select
Columns("A:AP").ClearContents
Sheets("F5").Select
Range("A6:P65000").ClearContents
On Error GoTo filenotthere
Workbooks.OpenText Filename:=dir _
& "\" & arq _
, Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier _
:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:= _
False, Comma:=True, Space:=False, Other:=False, FieldInfo:= _
Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array _
(20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), _
Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array( _
33, 1), Array(34, 1), Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), _
Array(40, 1)), TrailingMinusNumbers:=True

arq = Left(arq, 11)
ActiveWorkbook.SaveAs Filename:= _
dir & "\" & arq & ".xls" _
, FileFormat:=xlNormal, CreateBackup:=False


GoTo Continue
Exit Sub
filenotthere:
MyPrompt = "Houve um erro ao abrir o arquivo. É possível que o "
MyPrompt = MyPrompt & "arquivo NÃO tenha sido transferido para esta pasta. Clique em Ok para "
MyPrompt = MyPrompt & "procurar o arquivo. "
'ou clique em Cancelar para NÃO fazer"
'MyPrompt = MyPrompt & "a Base do M6."
Ans = MsgBox(MyPrompt, vbOKCancel)

If Ans = vbCancel Then Exit Sub

MyFile = Application.GetOpenFilename
If MyFile = False Then Exit Sub

On Error GoTo 0

Workbooks.OpenText Filename:=MyFile, _
Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier _
:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:= _
False, Comma:=True, Space:=False, Other:=False, FieldInfo:= _
Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array _
(20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), _
Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array( _
33, 1), Array(34, 1), Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), _
Array(40, 1)), TrailingMinusNumbers:=True


arq = Left(arq, 11)

ActiveWorkbook.SaveAs Filename:= _
dir & "\" & arq & ".xls" _
, FileFormat:=xlNormal, CreateBackup:=False

Continue:

Workbooks(arq & ".xls").Activate
Sheets(1).Select
ult_col = Cells(1, Columns.Count).End(xlToLeft).Column
ult_lin = Cells(Rows.Count, 1).End(xlUp).Row
Range(Cells(1, 1), Cells(ult_lin, ult_col)).Copy
Workbooks(MyName).Activate
Sheets("OnShoreA").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks(arq & ".xls").Close

On Error GoTo notfile

Workbooks.OpenText Filename:=dir _
& "\" & arq1 _
, Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier _
:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:= _
False, Comma:=True, Space:=False, Other:=False, FieldInfo:= _
Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array _
(20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), _
Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array( _
33, 1), Array(34, 1), Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), _
Array(40, 1), Array(41, 1), Array(42, 1)), TrailingMinusNumbers:=True

arq1 = Left(arq1, 14)
ActiveWorkbook.SaveAs Filename:= _
dir & "\" & arq1 & ".xls" _
, FileFormat:=xlNormal, CreateBackup:=False


GoTo Continue1
Exit Sub
notfile:
MyPrompt = "Houve um erro ao abrir o arquivo. É possível que o "
MyPrompt = MyPrompt & "arquivo NÃO tenha sido transferido para esta pasta. Clique em Ok para "
MyPrompt = MyPrompt & "procurar o arquivo. "
'ou clique em Cancelar para NÃO fazer"
'MyPrompt = MyPrompt & "a Base do M6."
Ans = MsgBox(MyPrompt, vbOKCancel)

If Ans = vbCancel Then Exit Sub

MyFile = Application.GetOpenFilename
If MyFile = False Then Exit Sub

On Error GoTo 0

Workbooks.OpenText Filename:=MyFile, _
Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier _
:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:= _
False, Comma:=True, Space:=False, Other:=False, FieldInfo:= _
Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array _
(20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), _
Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array( _
33, 1), Array(34, 1), Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), _
Array(40, 1), Array(41, 1), Array(42, 1)), TrailingMinusNumbers:=True


arq1 = Left(arq1, 14)

ActiveWorkbook.SaveAs Filename:= _
dir & "\" & arq1 & ".xls" _
, FileFormat:=xlNormal, CreateBackup:=False


Continue1:

Workbooks(arq1 & ".xls").Activate
Sheets(1).Select
ult_col = Cells(1, Columns.Count).End(xlToLeft).Column
ult_lin = Cells(Rows.Count, 1).End(xlUp).Row
Range(Cells(1, 1), Cells(ult_lin, ult_col)).Copy
Workbooks(MyName).Activate
Sheets("OnShoreB").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks(arq1 & ".xls").Close


may you guys help me? I need it as soon as possible.

thanks a lot,

Rafael
<!-- / message -->

 

[Peter_SSs]

Duplicate to http://www.mrexcel.com/forum/showthread.php?t=544266

Please do not post the same question multiple times. Questions of a duplicate nature will be locked or deleted, per the Posting Rules (especially points 21-23).

Any bumps, clarifications, or follow-ups should be posted back to the linked thread.