Excel macros – code does not execute

10 pts.
Tags:
Microsoft Excel
Microsoft Excel macros
I have written the following macro. I do not really see it necessary to explain ehat it does, I only need help with a problem - for some reason it does not reach the code after the loop. It does everything exactly as I want it until and into the loop, but does not execute the code after the loop at all. Could anyone be so kind as to take a look at it? Sub CopyFilesInDir() i = 1 Set objShell = CreateObject("Shell.Application") Set objFolder = objShell.BrowseForFolder(0, "Select Folder", 0, 0) If (Not objFolder Is Nothing) Then On Error Resume Next If IsError(objFolder.Items.Item.Path) Then MyDir = _ CStr(objFolder): GoTo Here On Error GoTo 0 If Len(objFolder.Items.Item.Path) > 3 Then MyDir = objFolder.Items.Item.Path & _ Application.PathSeparator Else MyDir = objFolder.Items.Item.Path End If Else: Application.ScreenUpdating = True: End End If Here: Set objFolder = Nothing: Set objShell = Nothing secondWS = "FP_2" Set MyNewFile = Workbooks.Add Set MyWS = MyNewFile.Worksheets.Add MyWS.Name = secondWS MyFileName = Dir(MyDir, 7) Do While MyFileName <> "" MyFile = MyDir & MyFileName Set wb = Workbooks.Open(MyFile) On Error Resume Next If Err <> 0 Then MsgBox (" òîçè ôàéë íÿìà ëèñò " & secondWS & "Çàòâàðÿì ôàéëà áåç êîïèðàíå.") wb.Close End If On Error GoTo 0 wb.Worksheets(secondWS).Activate Application.ScreenUpdating = False i = i + 1 MyNewFile.Worksheets(secondWS).Range("A1") = "Áóëñòàò" MyNewFile.Worksheets(secondWS).Range("B1") = "Èìå" MyNewFile.Worksheets(secondWS).Range("C1") = "Îáîðîò" MyNewFile.Worksheets(secondWS).Range("D1") = "Áðóòíà íîðìà íà ïå÷àëáàòà" MyNewFile.Worksheets(secondWS).Range("E1") = "Äîáàâåíà ñòîéíîñò íà åäèí çàåò" MyNewFile.Worksheets(secondWS).Range("F1") = "Íîðìà íà âúçâðúùàåìîñò íà ÄÌÀ" MyNewFile.Worksheets(secondWS).Range("G1") = "Îáùà çàäëúæíÿëîñò" MyNewFile.Worksheets(secondWS).Range("H1") = "Ïðèõîäè îò èçíîñ" wb.Worksheets(secondWS).Range("I5").Copy MyNewFile.Worksheets(secondWS).Cells(i, 1).PasteSpecial wb.Worksheets(secondWS).Range("C7").Copy MyNewFile.Worksheets(secondWS).Cells(i, 2).PasteSpecial wb.Worksheets(secondWS).Range("J12").Copy MyNewFile.Worksheets(secondWS).Cells(i, 3).PasteSpecial wb.Worksheets(secondWS).Range("J13").Copy MyNewFile.Worksheets(secondWS).Cells(i, 4).PasteSpecial wb.Worksheets(secondWS).Range("J14").Copy MyNewFile.Worksheets(secondWS).Cells(i, 5).PasteSpecial wb.Worksheets(secondWS).Range("J15").Copy MyNewFile.Worksheets(secondWS).Cells(i, 6).PasteSpecial wb.Worksheets(secondWS).Range("J16").Copy MyNewFile.Worksheets(secondWS).Cells(i, 7).PasteSpecial wb.Worksheets(secondWS).Range("J17").Copy MyNewFile.Worksheets(secondWS).Cells(i, 8).PasteSpecial Application.ScreenUpdating = True wb.Close MyFileName = Dir() Loop strPath = Workbooks("OBDanni.xls").Path MsgBox (strPath) MyNewFile.SaveAs strPath & "" & "OBD.xls", _ FileFormat:=xlNormal, _ Password:="", _ WriteResPassword:="", _ ReadOnlyRecommended:=False, _ CreateBackup:=False Etrap: Beep End Sub

Answer Wiki

Thanks. We'll let you know when a new response is added.

If you remark out “On Error GoTo 0″ the error that is generated will probably give you a clue.

Discuss This Question:  

 
There was an error processing your information. Please try again later.
Thanks. We'll let you know when a new response is added.
Send me notifications when members answer or reply to this question.

REGISTER or login:

Forgot Password?
By submitting you agree to receive email from TechTarget and its partners. If you reside outside of the United States, you consent to having your personal data transferred to and processed in the United States. Privacy

Forgot Password

No problem! Submit your e-mail address below. We'll send you an e-mail containing your password.

Your password has been sent to:

To follow this tag...

There was an error processing your information. Please try again later.

REGISTER or login:

Forgot Password?
By submitting you agree to receive email from TechTarget and its partners. If you reside outside of the United States, you consent to having your personal data transferred to and processed in the United States. Privacy

Thanks! We'll email you when relevant content is added and updated.

Following