10 pts.
Q:
Excel macros - code does not execute
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
ASKED: Mar 14 2009  10:47 AM GMT
1365 pts.
A:
 RATE THIS ANSWER
0
Click to Vote:
  •   0
  •  0
  • Bookmark and Share
If you remark out "On Error GoTo 0" the error that is generated will probably give you a clue.
Last Answered: Mar 16 2009  3:41 PM GMT by Ledlincoln   1365 pts.
Discuss This Answer:
_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _