Thread: import from 4 xls files to 1

Hello,
I am new to this forum and I am in need of assistance; i am trying to append data from 4 excel sheets into 1 excel sheet keeping the tab names intact and also copy the data by using a macro. The code:

HTML Code: 

Sub Transferdata()
    Dim basebook As Workbook
    Dim mybook As Workbook
    Dim i As Long
    Application.ScreenUpdating = False
    With Application.FileSearch
        .NewSearch
        .LookIn = "C:\Report Beta 1.1\Test Dump"
        .SearchSubFolders = False
        .FileType = msoFileTypeExcelWorkbooks
        If .Execute() > 0 Then
            Set basebook = ThisWorkbook
            For i = 1 To .FoundFiles.Count
                Set mybook = Workbooks.Open(.FoundFiles(i))
                mybook.Worksheets(1).Copy after:= _
                                                 basebook.Sheets(basebook.Sheets.Count)
                ActiveSheet.Name = mybook.Name
                With ActiveSheet.UsedRange
                    .Value = .Value
                End With
                mybook.Close
            Next i
        End If
    End With
    Application.ScreenUpdating = True
End Sub

This works for the initial run and imports the data but if I run the macro again it tries to keep adding the same tabs name which gives an error, i don't want it to add again just append the data to its respective tabs. Another thing that I would like is an import date to be inserted every time i run it. The date column will have to be specified or added to each sheet as I don't have one. Can someone please help with this problem?

Thanks in advance,
Rick

This should work. I've taken out the .Filesearch method as it was taken out of Excel in 2007+, this version will continue to work regardless of which version of Excel you run it on, once it's working the way you want. This should at least get you most of the way there...

...code removed, see further down

Thank you for the quick response JBeaucaire but when I replaced my code with yours it seems to run things but never shows anything and doesn't create any tabs.
any reason why?

Also, does this create an import date column when it imports (or copies over to the one excel sheet)? if not can you add it?

Sorry I am kind of new to this stuff.

Ok, try this, small tweaks and I tested this on some files on my system, seems good.

Option Explicit

Sub TransferData()
Dim wbBase As Workbook:     Set wbBase = ThisWorkbook
Dim MyBook As Workbook
Dim fName As String
Dim fPath As String
Dim wsName As String
Dim NR As Long

fPath = "C:\2011\"     'don't forget the final \
fName = Dir(fPath & "*.xls")

On Error Resume Next
Application.ScreenUpdating = False

Do While Len(fName) > 0
    Set MyBook = Workbooks.Open(fPath & fName)
    wsName = Left(MyBook.Name, InStrRev(MyBook.Name, ".") - 1)
    
    'check to see if sheet exists in main workbook already
    If Not Evaluate("ISREF([" & wbBase.Name & "]" & wsName & "!A1)") Then
        'if not, add it
        MyBook.Sheets(1).Copy after:=wbBase.Sheets(wbBase.Sheets.Count)
        With ActiveSheet
            .Name = wsName
            .UsedRange.Value = .UsedRange.Value
        End With
    Else
        'if so, add to it
        With wbBase.Sheets(wsName)
            NR = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), _
                SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
            MyBook.Sheets(1).UsedRange.Copy
            .Range("A" & NR).PasteSpecial xlPasteValues
        End With
    End If
            
    MyBook.Close False
    
    fName = Dir
Loop
    
Application.ScreenUpdating = True
End Sub

Works great so far, is there anyway to have it generate an import date in a new column in each sheet that way i can distinguish from like yesterdays imports, today's, tomorrows etc.?

thanks again!

Maybe this:

Option Explicit

Sub TransferData()
Dim wbBase As Workbook:     Set wbBase = ThisWorkbook
Dim MyBook As Workbook
Dim fName As String
Dim fPath As String
Dim wsName As String
Dim NR As Long

fPath = "C:\2011\"     'don't forget the final \
fName = Dir(fPath & "*.xls")

On Error Resume Next
Application.ScreenUpdating = False

Do While Len(fName) > 0
    Set MyBook = Workbooks.Open(fPath & fName)
    wsName = Left(MyBook.Name, InStrRev(MyBook.Name, ".") - 1)
    
    'check to see if sheet exists in main workbook already
    If Not Evaluate("ISREF([" & wbBase.Name & "]" & wsName & "!A1)") Then
        'if not, add it
        MyBook.Sheets(1).Copy after:=wbBase.Sheets(wbBase.Sheets.Count)
        With ActiveSheet
            .Name = wsName
            .UsedRange.Value = .UsedRange.Value
            .Columns(1).Insert xlShiftToRight
            .Range("A:A").SpecialCells(xlBlanks) = Date
        End With
    Else
        'if so, add to it
        With wbBase.Sheets(wsName)
            NR = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), _
                SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
            MyBook.Sheets(1).UsedRange.Copy
            .Range("B" & NR).PasteSpecial xlPasteValues
            .Range("A:A").SpecialCells(xlBlanks) = Date
        End With
    End If
            
    MyBook.Close False
    
    fName = Dir
Loop
    
Application.ScreenUpdating = True
End Sub

I tried the code and got an error on this line:

.Range("A:A").SpecialCells(xlblank) = Date

The error said "variable not defined"
It highlighted the "xlblank"

Thanks

Rick

Should be xlBlanks, plural.

Maybe this:

MyBook.Sheets(1).UsedRange.Offset(1).Copy

now it keeps adding the tabs instead of appending to the one there and adds a (2) at then end of the name, also the data it imports it knocks the date into a text instead of keeping it date. (not the date field but other fields i have in the other workbooks that are dates; yes those are formatted for date) It works on the initial run but after that when it appends is when it doesn't keep format.

I actually found for some reason that when i added a new excel sheet to the mix it would only duplicate the tabs that one instead of append not sure why but the offset works fine. So i guess it was me???!!!??? I believe it was due to spaces in the name.

We can merge all these fixes into one tweak:

        With wbBase.Sheets(wsName)
            NR = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), _
                SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
            MyBook.Sheets(1).UsedRange.Offset(1).Copy .Range("B" & NR)
            .Range("A:A").SpecialCells(xlBlanks) = Date
        End With

Originally Posted by RickR

I believe it was due to spaces in the name.

Hidden spaces are notorious for messing up text match logic.

Again you amaze me; wish i knew a fraction as you on this stuff.

The import date that you created always ends by itself for instance:

12/21/10 | data | data | data
12/21/10 | data | data | data
12/21/10

causes a blank row besides import date at end.