Extracting data from more than one files

[TG999]

Hello everybody
Tried on the pre defined solutions on the net but did not match.

In my excel file in sheet9 the first row is my own defined headers.
The output of the code will be from second row onwards.
On a command button click I want to open normal browse screen.
I will go in a particular drive in the required folder and pressing ctrl
key will select one or more than one excel files ( can be .xls or .xlsx or .xlsm ) and
give ok or open.
Why need browse screen because, evertime the target folder changes.
Imp:
Every file in the folder has a different header name in A1. Not to consider the names.
Every file in the folder has data in Sheet1 in column A and from A2 onwards, but since
all the Sheet1 has been differently renamed , kindly not consider the renamed sheet name
while defining the code. In code use Sheet1.

As I give open or ok, two things the code has to do.
1) Read the file names i.e before extension name and place all the names from column A to Z or
whatever but from second row.
2) Every file have values listed through out the column from
A2 onwards ( in the column there can be many cells in between that are blank ). Values
will be listed down from these file to sheet9 below the respective file names.

Thanks
TG999

 

[tonyyy]

TG999,

Welcome to the Board.

You might consider the following...

Sub LoopFiles()
Application.ScreenUpdating = False
Dim fd As FileDialog
Dim wb As Workbook
Dim ws As Worksheet, ws2 As Worksheet
Dim i As Long, j As Long

Set ws = ThisWorkbook.Sheets("Sheet9")
''''Open FileDialog and select file(s)
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
    .InitialView = msoFileDialogViewList
    .AllowMultiSelect = True
    If .Show = 0 Then Exit Sub
End With
j = 1
''''Loop through selected file(s)
For i = 1 To fd.SelectedItems.Count
    Set wb = Workbooks.Open(fd.SelectedItems(i))
    ws.Cells(2, j).Value = Left(wb.Name, InStrRev(wb.Name, ".") - 1)
    wb.Sheets(1).Range("A2:A" & wb.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row).Copy Destination:=ws.Cells(3, j)
    j = j + 1
    wb.Close savechanges:=False
Next i
ws.Columns.AutoFit
Application.ScreenUpdating = True
MsgBox "The dishes are done, dude!"
End Sub

In code use Sheet1.

Rather than try to reference a sheet by a name that likely doesn't exist, the code uses the index number - Sheets(1) - to reference the first sheet in each workbook.

Cheers,

tonyyy

 

[TG999]

Thanks fro reply tonyyy

giving error
Run time error '1004'
Application defined or object defined error
I have my actual file in the folder MainBranch from where the code will run.
I created on folder TEST.
Created two files
ABC.xls and renamed the sheet1 to Branch1 and put header in A1 and
some values though out the column with some cells in between blank.
similarly
XYZ.xlsm and renamed the sheet1 to Branch2 and put header in A1 and
some values though out the column with some cells in between blank.
Just let me know what mistake I am doing

Thanks

 

[TG999]

Hi Tonyyy

I reported an error above few hours back.
I was just checking the code again and found the problem.
All my files having the extension .xls where the file type in properties
is 97-2003. The code does not pick up the data and gives the error.
I have so many places still having xls format.
The code is working fine with xlsx and xlsm format.

Thanks

 

[bsquad]

give this a shot if you would like

Sub Aggregation2()
    Dim SourceSheet As Worksheet
    Dim OpenSourceWorkbook As Variant
    Dim SourceWorkbook As Workbook
    Dim x As Long
    Dim i As Integer
    Dim SCIndex As Long
        SCIndex = 1
    Dim TRIndex As Long
    
        Application.DisplayAlerts = False
        OpenSourceWorkbook = Application.GetOpenFilename(filefilter:="Excel Workbooks (*.xls; *xlsm,*.xls;*xlsm", _
                            Title:="Source File Select", MultiSelect:=True)
                            On Error GoTo ExitSub
        Set SourceWorkbook = Workbooks.Open(OpenSourceWorkbook(1))
        Application.ScreenUpdating = False
            For i = LBound(OpenSourceWorkbook) To UBound(OpenSourceWorkbook)
            TRIndex = 3
            Set SourceWorkbook = Workbooks.Open(Filename:=OpenSourceWorkbook(i), ReadOnly:=True)
                    For x = 2 To SourceWorkbook.Worksheets(1).UsedRange.Rows.Count
                        If SourceWorkbook.Worksheets(1).Cells(x, 1).Value <> "" Then
                            With ThisWorkbook.Worksheets("Sheet9")
                                .Cells(2, SCIndex).Value = Left(SourceWorkbook.Name, (InStrRev(SourceWorkbook.Name, ".", -1, vbTextCompare) - 1))
                                .Cells(TRIndex, SCIndex).Value = SourceWorkbook.Worksheets(1).Cells(x, 1).Value
                            End With
                            TRIndex = TRIndex + 1
                        End If
                    Next x
                SCIndex = SCIndex + 1
                SourceWorkbook.Close savechanges:=False
            Next i
                
ExitSub:
Exit Sub
End Sub

 

[TG999]

Hi bsquad
Thanks for reply
Your code worked fine for picking up all the type of files but
as I had mentioned in the code there will be blank cells at many places in
between through out the column. The code is skipping the blank cells and putting
up the values continuously one below the other. Also one option which Tonyyy had added on his own was the
autofit of columns width which I liked it.

Thanks

 

[tonyyy]

TG999,

Sorry, I haven't been able to reproduce the error; the code runs fine in my Windows 7, Excel 2010 environment with .xls and other excel files. Which line is highlighted when the error occurs?

 

[TG999]

Hello Tonyyy

How to know about the line getting highlighted .
I pasted the code in sheet9 and simply gave Run.
If I select only .xls file then it will just give the file name in column A2 but now
values below.
If the first selected file is .xls i.e ABC.xls and second is XYZ.xlsm the same above result.
Only ABC will be displayed in A2 and no values. Even XYZ is not displayed in B2.
But if I select only XYZ.xlsm and give ok the it will give perfect result.

One point that may help in detecting.
When I give Run in the code screen I get the error message. At that time on the left where the
sheet names are listed . In ABC.xls Sheet1(Branch1) is highlighted and as I give OK on the
error message screen, then the file from where I run the code MainBranch.xlsm Sheet9 (Sheet9) gets
highlighted. When I close the code screen then first I see ABC.xls file is already open. Then I close
that file and after that I see MainBranch.xlsm file where only ABC is displayed in A2.

Thanks

 

[tonyyy]

I pasted the code in sheet9...

So, delete the code in sheet9 and paste it into a regular module.

 

[TG999]

Hi Tonyyy
I checked the working it is working fine but this time different issue.

The below mentioned steps is while picking up files individually and not all together.

I picked first only one file ABC.xls. From A2 it has values till 11 cells downwards . Then
3 cells are empty then again 4 cells have value then 1 cell is empty and so on.
The file data is imported perfectly. I do not delete column1 and keep it as it is.
Now I pick up new file XYZ.xlsm which has only 8 values and all filled up from A2 onwards.
When I import that file then it does not list the data in column2 . It overwrites in column1.
And In column1 the values of the previous file from cell 9 onwards remains as it is.
-------------------------------
In case of files selecting together and importing.
If I pickup 4 files together first and then again import only two files
then the data of third and forth remains as it is and not deleted.

I hope if I am able to explain the problem

Thanks