Combine data of some cells in multiple excel files into one sheet

Pls try attached which modified from your file!

Originally Posted by Naveed Raza

Hi ricdamiani

In which way want the combine data means rows wise or column wise.

Hi Naveed Raza,
Thank you for your reply.

The idea is every single excel file is a row, and the cells I mentioned are the columns.
Do you think it is possible?

Thanks for that.

Originally Posted by lotuxel

Pls try attached which modified from your file!

Hi lotuxel,
Thank for your reply as well.

I had a look in the file and I didn't understand your macro.
Actually the goal is to get all the data from the mentioned cells from hundreds of excel files and combine them into 1 sheet.
The files would be the rows and the cells I mentioned would be the columns.
The sheets are all into C:\Users\5 - PRODUCTION\RUN SHEETS\

Is it something similar you did in your macro?

I thank you in advance.

Hi guys,

Anybody else can help with that?!

Cheers!

Hi rocdamiani,
Pls see below and you have to put all the files to one file's sheets and Goal sheet is target sheet.

Sub jw_test()
Dim wb As Workbook
Dim ws As Worksheet
Dim ws1 As Worksheet
Dim re As Variant
Dim i As Long
Dim j As Long
Dim rng As String
   
Set wb = ActiveWorkbook
Set ws = wb.Worksheets("Goal")
j = 2
For Each ws1 In wb.Worksheets

   If ws1.Name <> "Goal" Then
         ws.Cells(j, 1) = ws1.Name
      For i = 0 To 100
            re = Array("C3", "C5", "C8", "D8", "E8", "D9", "G13", "H13", "F22", "F24", "F26", "F29", "F31", "F34", "F40", "D43", "E43", "F46", "D49", "E49", "F52", "F55", "C58", "C59", "C60", "C61", "C62", "")
            rng = re(i)
            If rng = "" Then Exit For
                ws.Cells(j, i + 2) = ws1.Range(rng).Value
     Next i
     End If
     j = j + 1
Next ws1
End Sub

Originally Posted by ricdamiani

Hi lotuxel,
Thank you for your reply.

Sorry but I didn't understand very well.
I thought the macro was going to open each excel file in the folder and copy those cells into the goal sheet.
Is that happening in the macro? Or how it works? I couldn't understand very well your explanation before the code

Looking forward to hear from you

Yes!, I try to add the purposes :

'assign the active workbook
Set wb = ActiveWorkbook
'assign ws to target sheet
Set ws = wb.Worksheets("Goal")
j = 2
'loop all the sheets in active workbook
For Each ws1 In wb.Worksheets
'if the sheet (ws) 's name is not Goal
   If ws1.Name <> "Goal" Then
      'put the sheet name to goal sheet start from row no. 2 and col A
         ws.Cells(j, 1) = ws1.Name
       'loop the all required range start from C3
      For i = 0 To 100
            re = Array("C3", "C5", "C8", "D8", "E8", "D9", "G13", "H13", "F22", "F24", "F26", "F29", "F31", "F34", "F40", "D43", "E43", "F46", "D49", "E49", "F52", "F55", "C58", "C59", "C60", "C61", "C62", "")
            rng = re(i)
               'if all range finsihed
            If rng = "" Then Exit For
            'place the data (value) of target sheet value from the range from from array
                ws.Cells(j, i + 2) = ws1.Range(rng).Value
     Next i
     End If
     'prepare for next row in goal sheet
     j = j + 1
     'start to next sheet

hope you got the idea.

Hi guys,

Anyone able to help me on that now?

Cheers!

Hi ricdamiani,
please find attached,let us know if this serves your purpose or not!

Goal.xlsm

Thanks

Hi ricdamiani,
Did you check the file i sent ? anyways pasting here

Private Sub Workbook_Click()
   
    Dim wbMaster As Workbook
    Dim ws       As Worksheet
    Dim desws    As Worksheet
    Dim NextRow  As Long
    Dim Fpath    As String
    Dim Fname    As String
    Dim strName  As String
    Dim j        As Long
    j = 2
    Set wbMaster = Workbooks("Goal.xlsm")
    Set desws = Worksheets("Sheet1")
    Fpath = "C:\Users\Username\Desktop\forum\" ' change to your directory
    Fname = Dir(Fpath & "2*.xls")
    
    Application.ScreenUpdating = False
    
    Do While Fname <> ""
        

        'strName = Left(InStr(Fname, ".") - 1)
        strName = Left(Fname, InStr(Fname, "."))
        With Workbooks.Open(Fpath & Fname)
        
            For Each ws In .Sheets(Array("Sheet1"))
            
                
                    For i = 0 To 100
                    re = Array("C3", "C5", "C8", "D8", "E8", "D9", "G13", "H13", "F22", "F24", "F26", "F29", "F31", "F34", "F40", "D43", "E43", "F46", "D49", "E49", "F52", "F55", "C58", "C59", "C60", "C61", "C62", "")
                    rng = re(i)
                    If rng = "" Then Exit For
                    desws.Cells(j, i + 2) = ws.Range(rng).Value
                    desws.Cells(j, 1) = strName

                    Next i
                    j = j + 1
            Next ws
            
            .Close SaveChanges:=False
        
        End With
        
        Fname = Dir
         
    Loop
    
    Application.ScreenUpdating = True
End Sub

Originally Posted by Ariff_Chowdhury

Hi ricdamiani,
Did you check the file i sent ? anyways pasting here

Hi Ariff,

IT WORKED!!!!
Thanks a loooooooooooot!!!!
You are the best HAHHAHA

Cheers!
Ric

You're welcome!
if you are satisfied with the solution provided so please mark this thread as solved! So other can reach to this easily

Thank you too