Open all files in directory except one - ActiveWorkbook. Path, ScreenUpdating, Dir, Open, CountA, Close

Sub Open_My_Files()

     Dim MyFile As String
     Dim DalsiRadek As Integer
     Dim strWBname As String

         strWBname = ActiveWorkbook.Name

     mypath = ActiveWorkbook.Path & "\"
         MyFile = Dir(mypath)

Application.ScreenUpdating = False

Do While MyFile <> ""

     If MyFile <> strWBname Then
         If MyFile Like "*.xls" Then

             Workbooks.Open mypath & MyFile
                 Sheets("result").Select
                     Range("B3:AW3").Select
                         Selection.Copy

             Windows(strWBname).Activate
                 DalsiRadek = Application.WorksheetFunction.CountA(Range("B:B")) + 5
                     Cells(DalsiRadek, 2).Select
                         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                         :=False, Transpose:=False

                 Workbooks(MyFile).Activate
                     ActiveWorkbook.Close True

         End If
     End If
                 MyFile = Dir
Loop

Application.ScreenUpdating = True

End Sub






Main   +       

2009