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]

As you are now opening 6 files rather than the original 3, where do you want the output to go?

 

[dinunan]

Output is still the same. Before 3 files with two worksheets each. So 6 ranges copy and pasting. Now 6 files with two worksheets each but copying from either of the worksheets. so still 6 ranges to copy and paste. Destination range is same.

 

[Fluff]

How about

Sub LoopThroughFolder()

   Dim MyFile As String, Str As String, MyDir As String, Wb As Workbook
   Dim Fldr As String
   Dim Rws As Long, Rng As Range
   Dim Cols As Long
   Dim Colx As Long
   Set Wb = ThisWorkbook
   
   Application.ScreenUpdating = 0
   Application.DisplayAlerts = 0
   
   Cols = 5
   Colx = 5
   With Application.FileDialog(msoFileDialogFolderPicker)
      .InitialFileName = "C:\MacrosTest"
      .Title = "Please select a folder"
      If .Show = -1 Then
         Fldr = .SelectedItems(1)
      End If
   End With
   
   MyFile = Dir(Fldr & "\*.xls*")
   
   Do While MyFile <> ""
      Workbooks.Open (MyFile)

      If Right(MyFile, 1) = "s" Then
         With Worksheets(1)
            Set Rng = .Range(.Cells(5, "N"), .Cells(32, "N"))
            Rng.Copy Wb.Worksheets("BATTERY10").Cells(5, Cols)
            Cols = Cols + 1
         End With
      Else
         With Worksheets(2)
            Set Rng = .Range(.Cells(5, "N"), .Cells(34, "N"))
            Rng.Copy Wb.Worksheets("UNIT 700").Cells(5, Colx)
            Colx = Colx + 1
         End With
      End If
      ActiveWorkbook.Close True
      MyFile = Dir()
   Loop
Application.DisplayAlerts = True
End Sub

 

[dinunan]

Cope is halting at (with yellow highlight)

workbooks.open (MyFile)

 

[Fluff]

Try changing it to

      Workbooks.Open (Fldr & "\" & MyFile)

 

[dinunan]

Try changing it to

      Workbooks.Open (Fldr & "\" & MyFile)

Hi, it is forcing the excel to close and restart!!

 

[Fluff]

Can you open all the files in that folder manually?
It may be that one of them has been corrupted.

 

[dinunan]

Yes, all files opening manually.

Excel says not enough memory, consider using 64 bit version etc

Previous suggestion (*.xls* and with worksheet code) is working good but strangely it is deleting one range before pasting next (only for one file, other 5 ranges copying correctly).

 

[Fluff]

The code doesn't delete anything. Are you sure that all columns in the books being opened contain values?

 

[dinunan]

The code doesn't delete anything. Are you sure that all columns in the books being opened contain values?

Yes, all contains values.
If I keep the concerned file .xls alone in the folder, data is getting copied from it. If I keep 5 files (2 .xls and 3 .xlsx), data from that file is getting copied but when I keep six files (i.e. 3 .xls and 3 .xlsx) then data from that particular file is not getting copied over.