Import rage from different workbook, into new workbook

[Yulyo]

Hello all,
I am trying to create a macro, to do this:
- macro will be placed on a new workbook, called "final". this workbook will have a lot of sheets "munchen", "wien", "paris" etc.
- when run, the macro will find the newest file in a folder , will open the file, copy some data from every sheet and paste it on workbook "final", sheet "munchen"
- after this, it will find the newest file in another folder, open the file, copy data from every sheet and paste it in workbook "final", sheet "wien"

etc etc

I managed to create something, but considering the fact that i have around 80-90 sheets, i think that it must be a easier solution

This is what i have right now...

Thank you!

<code style="margin: 0px; padding: 0px; font-style: inherit; font-weight: inherit; line-height: 12px;">Sub ACT()

Dim MyPath As String
Dim MyFile As String
Dim LatestFile As String
Dim LatestDate As Date
Dim LMD As Date


MyPath = "C:\Users\computer\Desktop\test\cerere"
If Right(MyPath, 1) <> "" Then MyPath = MyPath & ""
MyFile = Dir(MyPath & "*.xls", vbNormal)
If Len(MyFile) = 0 Then
MsgBox "No file found!", vbExclamation
Exit Sub
End If

Do While Len(MyFile) > 0
LMD = FileDateTime(MyPath & MyFile)
If LMD > LatestDate Then
LatestFile = MyFile
LatestDate = LMD
End If
MyFile = Dir
Loop

Workbooks.Open MyPath & LatestFile, ReadOnly:=True
ThisWorkbook.Worksheets("MUNCHEN").Range("A2:C2").Value = ActiveWorkbook.Worksheets("123").Range("A5:C5").Value
ThisWorkbook.Worksheets("MUNCHEN").Range("E2:F3").Value = ActiveWorkbook.Worksheets("123").Range("D12:E13").Value
ThisWorkbook.Worksheets("MUNCHEN").Range("A5:C5").Value = ActiveWorkbook.Worksheets("234").Range("A5:C5").Value
ThisWorkbook.Worksheets("MUNCHEN").Range("E5:F6").Value = ActiveWorkbook.Worksheets("234").Range("D12:E13").Value
ThisWorkbook.Worksheets("MUNCHEN").Range("A8:C8").Value = ActiveWorkbook.Worksheets("345").Range("A5:C5").Value
ThisWorkbook.Worksheets("MUNCHEN").Range("E8:F9").Value = ActiveWorkbook.Worksheets("345").Range("D12:E13").Value
ThisWorkbook.Worksheets("MUNCHEN").Range("A11:C11").Value = ActiveWorkbook.Worksheets("456").Range("A5:C5").Value
ThisWorkbook.Worksheets("MUNCHEN").Range("E11:F12").Value = ActiveWorkbook.Worksheets("456").Range("D12:E13").Value
ThisWorkbook.Worksheets("MUNCHEN").Range("A14:C14").Value = ActiveWorkbook.Worksheets("567").Range("A5:C5").Value
ThisWorkbook.Worksheets("MUNCHEN").Range("E14:F15").Value = ActiveWorkbook.Worksheets("567").Range("D12:E13").Value
ThisWorkbook.Worksheets("MUNCHEN").Range("A17:C17").Value = ActiveWorkbook.Worksheets("678").Range("A5:C5").Value
ThisWorkbook.Worksheets("MUNCHEN").Range("E17:F18").Value = ActiveWorkbook.Worksheets("678").Range("D12:E13").Value
ThisWorkbook.Worksheets("MUNCHEN").Range("A20:C20").Value = ActiveWorkbook.Worksheets("789").Range("A5:C5").Value
ThisWorkbook.Worksheets("MUNCHEN").Range("E20:F21").Value = ActiveWorkbook.Worksheets("789").Range("D12:E13").Value</code>

 

[Norie]

What sheets/ranges in the workbook you are opening will you be copying from for each tab in the 'Final' workbook?

 

[Yulyo]

I am trying to import ranges A5:C5 and D12:E13 from every sheet found in the opened workbook.
I will try to post an xls example.

 

[Yulyo]

https://drive.google.com/open?id=1fUYM_YTiT2h9kXnnJC6yngjns2-0y3eP
Please download the attached file. (you must change the path for "Munchen" file in the VBA)

Thank you !

 

[Norie]

Can't download the file right now, I will later, but can I ask if it's the same sheets/ranges being copied every time?

 

[Yulyo]

The name of the source sheets are different. But the range is the same for all sheets/workbooks: A5:C5 and D12:E13

 

[Norie]

How are the source sheets determined for each destination sheet?

 

[Yulyo]

Basically i just need the code part that flip throught all the sheets in "Munchen" workbook and copy A5:C5 and D12:E13 on "Final" workbook, on the same sheet, in order...

 

[Yulyo]

I managed to do it.
I post the code here, in case someone else need it.

Thanx a lot for your time, Norie!

Sub MUNCHEN()




Dim MyPath As String
Dim MyFile As String
Dim LatestFile As String
Dim LatestDate As Date
Dim LMD As Date
Dim wb As Workbook
Dim DestSh As Worksheet
Dim i As Integer






MyPath = "C:\Users\Computer\Desktop\test\"
If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
MyFile = Dir(MyPath & "*.xls", vbNormal)
If Len(MyFile) = 0 Then
MsgBox "No file!!", vbExclamation
Exit Sub
End If


Do While Len(MyFile) > 0
LMD = FileDateTime(MyPath & MyFile)
If LMD > LatestDate Then
LatestFile = MyFile
LatestDate = LMD
End If
MyFile = Dir
Loop


Workbooks.Open MyPath & LatestFile, ReadOnly:=True




    Set wb = ThisWorkbook
    Set DestSh = wb.Sheets("MUNCHEN")




    i = 1
    For Each sh In ActiveWorkbook.Worksheets
        sh.Range("A5:C5").Copy
        With DestSh.Range("A" & i + 1)
            .PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        End With
    i = i + 1


    Next
    
    
    i = 1
    For Each sh In ActiveWorkbook.Worksheets
        sh.Range("D13:E13").Copy
        With DestSh.Range("F" & i + 1)
            .PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        End With
    i = i + 1


    Next
    ActiveWorkbook.Close SaveChanges:=False
End Sub