Combine Data from different workbooks

Is it possible too do this if they are on the same computer. Lets say I want all the data on page3 in one workbook, data on page2 in another and have it show up in another workbook. If this can be done can it delete cell entry that match?

Thanks

Will the workbooks be open?
Will they all be in one Directory?
Will the data have a header row?

Why is this post marked solved?

Ypu've marked the thread solved that would suggest that you have received an answer.

Place this code in your master workbook. This code goes in a standard module - it will prompt the user to pick the folder containing the files - keep a separate folder for these files.

Option Explicit

' API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
                                     Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal _
                                                                                       pszpath As String) As Long

Declare Function SHBrowseForFolder Lib "shell32.dll" _
                                   Alias "SHBrowseForFolderA" (lpBrowseInfo As BrowseInfo) _
                                   As Long

Public Type BrowseInfo
    hOwner     As Long
    pIDLRoot   As Long
    pszDisplayName As String
    lpszTitle  As String
    ulFlags    As Long
    lpfn       As Long
    lParam     As Long
    iImage     As Long
End Type

Function GetDirectory(Optional msg) As String
    On Error Resume Next
    Dim bInfo  As BrowseInfo
    Dim sPath  As String
    Dim r As Long, x As Long, pos As Integer

    'Root folder = Desktop
    bInfo.pIDLRoot = 0&

    'Title in the dialog
    If IsMissing(msg) Then
        bInfo.lpszTitle = "Please select the folder containing the Excel files to copy."
    Else
        bInfo.lpszTitle = msg
    End If

    'Type of directory to return
    bInfo.ulFlags = &H1

    'Display the dialog
    x = SHBrowseForFolder(bInfo)

    'Parse the result
    sPath = Space$(512)
    r = SHGetPathFromIDList(ByVal x, ByVal sPath)
    If r Then
        pos = InStr(sPath, Chr$(0))
        GetDirectory = Left(sPath, pos - 1)
    Else
        GetDirectory = ""
    End If
End Function

Place this code in another module, it will do the actual merge - using the above function to get the folder

Sub Get_Data_From_All()
    Dim wbSource As Workbook
    Dim wbThis As Workbook
    Dim rToCopy As Range
    Dim uRng   As Range
    Dim rNextCl As Range
    Dim lCount As Long
    Dim bHeaders As Boolean

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False

        On Error GoTo exithandler

        Set wbThis = ThisWorkbook
        'clear the range except  headers
        Set uRng = wbThis.Worksheets(1).UsedRange
        If uRng.Cells.Count <= 1 Then
            'no data in master sheet
            bHeaders = False
        Else: uRng.Offset(1, 0).Resize(uRng.Rows.Count - 1 _
                                       , uRng.Columns.Count).ClearContents
            bHeaders = True
        End If

        With .FileSearch
            .NewSearch
            'Get directory containing files
            .LookIn = GetDirectory
            .FileType = msoFileTypeExcelWorkbooks

            If .Execute > 0 Then    'Workbooks in folder
                For lCount = 1 To .FoundFiles.Count    ' Loop through all.
                    'Open Workbook x and Set a Workbook  variable to it
                    Set wbSource = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)
                    Set rToCopy = wbSource.ActiveSheet.UsedRange
                    With wbThis.Worksheets(1)
                        Set rNextCl = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
                        If bHeaders Then
                            'headers exist so don't copy
                            rToCopy.Offset(1, 0).Resize(rToCopy.Rows.Count - 1, _
                                                        rToCopy.Columns.Count).Copy rNextCl
                            'no headers so copy
                            'place headers in Row 2
                        Else: rToCopy.Copy .Cells(2, 1)
                            bHeaders = True
                        End If
                    End With
                    wbSource.Close False     'close source workbook
                Next lCount
            Else: MsgBox "No workbooks found"
            End If
        End With
        MsgBox "Done", vbInformation, "Import Data"
        Exit Sub
exithandler:
        MsgBox "aborted"
        .ScreenUpdating = True
        .DisplayAlerts = True
        .EnableEvents = True
    End With
End Sub

I used your original workbooks - master, test1 & test2.

The code goes in the workbook that you are importing to. The workbooks containing the data to import in any other directory - I would set up a specific folder to hold them.

can I ask why the data is in different workbooks?

You hadn't copied the code correctly. The attached workbook contains the code set to copy data from sheet4 of all workbooks in the specified folder

Move the master out of that folder.

If you want them all in one folder I will have to amend the code.

I don't understand why it is necessary. Why have two journals, what is the data stored from?

It looks to me as if you are storing invoice data, this should all be done in the same workbook

Here's an example of what I mean

http://www.excelforum.com/excel-prog...-tracking.html

Just had a look at your latest workbooks. I think you ar making this far more complicated than necessary. Take a look at my suggestion in the link in my last post.

I really don't see the need for different workbooks, but why not have a separate journal book & save to that instead?

I see what you mean about the code needing tidying up(LOL). Try using this for your ComboBox1

Private Sub ComboBox1_Change()  'add entry to invoice
    Dim NextCl As Range
    With Sheet1
        Set NextCl = .Cells(55, 2).End(xlUp).Offset(1, 0)
        If IsEmpty(NextCl) Then
            NextCl.Value = Me.ComboBox1.Text
        Else: MsgBox "Invoice is full. Add extra lines", vbCritical, "Input error"
            Exit Sub
        End If
    End With
End Sub

I see where you are using VLOOKUP in the code, but you don't need to wipe these formulas in the sheet. Just clear the main body of the invoice, as I have in the example I pointed you to.

I've created a named range for the invoice body that the button will clear
The address book sheet contains two Dynamic Named Ranges (AddressBook - used in VLOOKUP, and names used in the Data validation)

I've made some changes to the userform, you need to remove all the code that is not actually used.

Let me know if you want to write the details straight to a master journal

Originally Posted by zplugger

one other thing, could I merge my oneday into my twoday for one book?

Try this updated book, I have changed the code & design. The invoice body is now populated using Data validation. You can add to the product list & it will be inluded automatically in the drop down.

The lists are Data validation, see

http://www.excel-it.com/data_validation.htm

You should always consider non-VBA approaches first. Even the invoice number could be generated using a formula.