Macro to run in files inside a folder

[dinunan]

Hello All
I am trying to write one macro to run on 3 files inside a folder. Code is written but it copies data and overwrites in the same range for next files. I want data from source file to go in target file range G5:G32 for 1 st file/E5:E32 for second file and F5:F32 for third file. Each source file has two sheets to bring data from. Also target file has two sheets for the data to go into. Here is the code so far. Trying offset but no success!

Sub LoopThroughFolder()


Dim MyFile As String, Str As String, MyDir As String, Wb As Workbook
Dim Rws As Long, Rng As Range
Set Wb = ThisWorkbook

MyDir = "C:\MacrosTest\Folder Testing"
MyFile = Dir(MyDir & "*.xlsx")
ChDir MyDir
Application.ScreenUpdating = 0
Application.DisplayAlerts = 0


Do While MyFile <> ""
Workbooks.Open (MyFile)
With Worksheets(1)
Set Rng = Range(.Cells(5, "N"), .Cells(32, "N"))
Rng.Copy Wb.Worksheets("BATTERY10").Cells(5, "G")
End With

With Worksheets(2)
Set Rng = Range(.Cells(5, "N"), .Cells(34, "N"))
Rng.Copy Wb.Worksheets("UNIT 700").Cells(5, "G")
ActiveWorkbook.Close True

End With
MyFile = Dir()
Loop


End Sub

 

[Fluff]

Hia & welcome to MrExcel
Untested, but try

Sub LoopThroughFolder()

Dim MyFile As String, Str As String, MyDir As String, Wb As Workbook
Dim Rws As Long, Rng As Range
Dim Cnt As Long
Dim Col As String
Set Wb = ThisWorkbook

MyDir = "C:\MacrosTest\Folder Testing\"
MyFile = Dir(MyDir & "*.xlsx")
Application.ScreenUpdating = 0
Application.DisplayAlerts = 0

Cnt = 1
Do While MyFile <> ""
Workbooks.Open (MyFile)
Select Case Cnt
    Case 1
        Col = "G"
    Case 2
        Col = "E"
    Case 3
        Col = "F"
End Select
    
With Worksheets(1)
Set Rng = .Range(.Cells(5, "N"), .Cells(32, "N"))
Rng.Copy Wb.Worksheets("BATTERY10").Cells(5, Col)
End With

With Worksheets(2)
Set Rng = .Range(.Cells(5, "N"), .Cells(34, "N"))
Rng.Copy Wb.Worksheets("UNIT 700").Cells(5, Col)
ActiveWorkbook.Close True
Cnt=Cnt+1
End With
MyFile = Dir()
Loop
Application.DisplayAlerts = True

End Sub

 

[dinunan]

Hi Fluff
Worked like champ!! Thanks a lot!!!

 

[dinunan]

Hi Further to this, daily we create one new folder named with todays date like 09-08-2017, 10-08-2017 etc and in each folder we save three shift reports (3 files). With the present code, we have to edit macro everyday to refer to todays folder and then run the macro. Is there anyway we could avoid macro editing for folder path. With this macro we saved at least 20 min of copy pasting job. People here are not comfortable with macro editing etc, they want simple solution.

 

[Fluff]

Try this

Sub LoopThroughFolder()

Dim MyFile As String, Str As String, MyDir As String, Wb As Workbook
Dim Rws As Long, Rng As Range
Dim Cnt As Long
Dim Col As String
Set Wb = ThisWorkbook

MyDir = "C:\MacrosTest\Folder Testing\" & Format(Date, "dd-mm-yyyy") & "\"
MyFile = Dir(MyDir & "*.xlsx")
Application.ScreenUpdating = 0
Application.DisplayAlerts = 0

Cnt = 1
Do While MyFile <> ""
Workbooks.Open (MyDir & MyFile)
Select Case Cnt
    Case 1
        Col = "G"
    Case 2
        Col = "E"
    Case 3
        Col = "F"
End Select
    
With Worksheets(1)
Set Rng = .Range(.Cells(5, "N"), .Cells(32, "N"))
Rng.Copy Wb.Worksheets("BATTERY10").Cells(5, Col)
End With

With Worksheets(2)
Set Rng = .Range(.Cells(5, "N"), .Cells(34, "N"))
Rng.Copy Wb.Worksheets("UNIT 700").Cells(5, Col)
ActiveWorkbook.Close True
Cnt = Cnt + 1
End With
MyFile = Dir()
Loop
Application.DisplayAlerts = True

End Sub

Where the folder is called
C:\MacrosTest\Folder Testing\18-08-2017

 

[dinunan]

Nothing is happening! Macro not executing.
Each folder would have total 4 files - three shift reports and one Average file which is having macro. At present we open Average file from the same folder, edit folder path to todays folder and then running macro. It is working. But your code above is not doing anything, even error not coming. Anything to modify?

 

[Fluff]

If the files are all in the same folder try

Sub LoopThroughFolder()

    Dim MyFile As String, Str As String, MyDir As String, Wb As Workbook
    Dim Rws As Long, Rng As Range
    Dim Cnt As Long
    Dim Col As String

Application.ScreenUpdating = 0
Application.DisplayAlerts = 0
   
    Set Wb = ThisWorkbook
    
    MyDir = Wb.Path & "\"
    MyFile = Dir(MyDir & "*.xls")
    
    Cnt = 1
    Do While MyFile <> ""
        If Not MyFile = Wb.Name Then
            Workbooks.Open (MyDir & MyFile)
            Select Case Cnt
                Case 1
                    Col = "G"
                Case 2
                    Col = "E"
                Case 3
                    Col = "F"
            End Select
                
            With Worksheets(1)
                Set Rng = .Range(.Cells(5, "N"), .Cells(32, "N"))
                Rng.Copy Wb.Worksheets("BATTERY10").Cells(5, Col)
            End With
            
            With Worksheets(2)
                Set Rng = .Range(.Cells(5, "N"), .Cells(34, "N"))
                Rng.Copy Wb.Worksheets("UNIT 700").Cells(5, Col)
                ActiveWorkbook.Close True
                Cnt = Cnt + 1
            End With
        End If
        MyFile = Dir()
    Loop

Application.DisplayAlerts = True

End Sub

 

[dinunan]

Hi Fluff
It is working!!!!
No more macro editing or folder selection required. Thanks a lot!

 

[Fluff]

Glad to help & thanks for the feedback

 

[dinunan]

Hello Fluff
Just for learning purpose,
If I've to open "Select a Folder" dialogue box, then how do I reference our code to that folder? I used some code in the same code but not working!!!

Sub LoopThroughFolder()


Dim MyFile As String, Str As String, MyDir As String, Wb As Workbook
Dim Rws As Long, Rng As Range
Dim Cnt As Long
Dim Col As String
Set Wb = ThisWorkbook


'MyDir = "C:\MacrosTest\Folder Testing"
'MyFile = Dir(MyDir & "*.xlsx")


Application.ScreenUpdating = 0
Application.DisplayAlerts = 0


With Application.FileDialog(msoFileDialogFilePicker)
.InitialFileName = "C:\MacrosTest"
.Title = "Please select a folder"
If .Show = -1 Then
sfolder = .SelectedItems(1)
End If
End With
'MyDir = sfolder
'MyFile = Dir(MyDir & "*.xlsx")




Cnt = 1
'ChDir MyDir
Do While MyFile <> ""
Workbooks.Open (MyFile)