Help to Combine multiple sheets with variance range into master

[nhnn1986]

Hi all:

I want to copy data form multiple sheet to master that
Source: Multiple excel file, the same sheets name "G034141", Range("A19:L" & lastrow)
with lastrow = sheets("G034141").Range("A" & Rows.Count).Row - 1
Destinations: Thisworkbook.sheets("master")

This code can copy all data from multiple excel files but in fixed range("A19:L280")
Please help me change code or have another option to do this.

Thanks./.

Public Sub DATA()Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim cn As Object, rs As Object, i As Byte, lr As Long, lrG03414 As Long, fso As Object
Set cn = CreateObject("adodb.connection")
Set fso = CreateObject("Scripting.FileSystemObject")
Sheets("master").Range("A1").CurrentRegion.Offset(1).ClearContents
    With Application.FileDialog(msoFileDialogOpen)
        .Filters.Clear
        .Filters.Add "G03414", "*.xl*"
        .InitialFileName = "G03414*"
        .AllowMultiSelect = True
        .Show
        For i = 1 To .SelectedItems.Count
            cn.Open ("provider=Microsoft.ACE.OLEDB.12.0;data source=" & .SelectedItems(i) & ";mode=Read;extended properties=""Excel 12.0;hdr=no"";")
        lr = .SelectedItems.Range("A" & Rows.Count).End(3).Row - 1
        Set rs = cn.Execute("select '" & fso.GetBaseName(.SelectedItems(i)) & "',f1,f2,f3,f4,f5,f6,f7,f8,f9,val(f10),val(f11),val(f12) from [G034141$A18:L280] ")
       
            lr = Sheets("master").Range("A" & Rows.Count).End(3).Row
            If Not rs.EOF Then Sheets("master").Range("A" & lr + 1).CopyFromRecordset rs
            rs.Close
            cn.Close
        Next
    End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

 

[JLGWhiz]

Are you trying to retrieve files from the interner or from closed documents? If not, why use the 'adodb' method to access the files?

 

[JLGWhiz]

If your master workbook is in the same directory as your source files and you are not trying to pull data from a page on an internet site, then this might work.

Sub t()
Dim wb As Workbook, fPath As String, fName As String, sh As Worksheet, lr As Long
fPath = ThisWorkbook.Path & "\"
fName = Dir(fPath & "*.xls*")
    Do While fName <> ""
        If fName <> ThisWorkbook.Name Then
            Set wb = Workbooks.Open(fPath & fName)
            On Error Resume Next
                If IsError(Sheets("G034141")) Then GoTo SKIP:
            lr = wb.Sheets("G034141").Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
            On Error GoTo 0
            Err.Clear
            wb.Sheets("G034141").Range("A19:L" & lr).Copy ThisWorkbook.Sheets("Master").Cells(Rows.Count, 1).End(xlUp)(2)
SKIP:
            wb.Close
            Set wb = Nothing
        End If
        fName = Dir
    Loop
End Sub

 

[nhnn1986]

Thanks for your respond @JLGWhiz but I want code can do:

Brown to folder then choose file get data, this mean measter wk not in the same folder with source file and I want get some of sourcer file, not all files
Source file are close documents

So do you have any idea help me to do this

 

[JLGWhiz]

See if this is better

Sub t2()
Dim wb As Workbook, fName As Variant, sh As Worksheet, lr As Long
fName = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", , "Browse for files", MultiSelect:=True)
        For i = LBound(fName) To UBound(fName)
            Set wb = Workbooks.Open(fName(i))
            On Error Resume Next
            If IsError(Sheets("G034141")) Then GoTo SKIP:
            lr = wb.Sheets("G034141").Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
            wb.Sheets("G034141").Range("A19:L" & lr).Copy ThisWorkbook.Sheets("Master").Cells(Rows.Count, 1).End(xlUp)(2)
            
SKIP:
            On Error GoTo 0
            Err.Clear
            wb.Close False
            Set wb = Nothing
        Next
End Sub

You can select multiple files by pressing the Ctrl key as you click on the files you want. Those files will then be put into an array for the fName variable after you click 'Open' on the filedialog box.

 

[nhnn1986]

Thanks code work, can you add for more option that:
1. When brown to folder but don't choose file, this mean Click cancle => mistake in line "For i = LBound(fName) To UBound(fName)" and have notice "type missmatch"
2. Copy source file base name patch in column A of sheets("Master") each row
3. When open file name filter only source files like G03414*.xl*. Because my source folder have over 300 files with diffrience name.
Many thanks./.

 

[JLGWhiz]

I am not so sure that the file filter will work like you want it to, but you can give it a try.

Sub t2()
Dim wb As Workbook, fName As Variant, sh As Worksheet, lr As Long, s As Range, e As Range
fName = Application.GetOpenFilename("Excel Files (G034141*.xls*), G034141*.xls*", , "Browse for files", MultiSelect:=True)
    If fName = False Then
        MsgBox "No File Chosen, procedure will end"
        Exit Sub
    End If
        For i = LBound(fName) To UBound(fName)
            Set wb = Workbooks.Open(fName(i))
            On Error Resume Next
            If IsError(Sheets("G034141")) Then GoTo SKIP:
            lr = wb.Sheets("G034141").Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
            wb.Sheets("G034141").Range("A19:L" & lr).Copy ThisWorkbook.Sheets("Master").Cells(Rows.Count, 2).End(xlUp)(2)
            With ThisWorkbook.Sheets("Master")
                Set s = .Cells(Rows.Count, 1).End(xlUp)(2)
                Set e = .Cells(Rows.Count, 2).End(xlUp).Offset(, -1)
                .Range(s, e) = wb.Name
                Set s = Nothing
                Set e = Nothing
            End With
SKIP:
            On Error GoTo 0
            Err.Clear
            wb.Close False
            Set wb = Nothing
        Next
End Sub

 

[nhnn1986]

Thanks @JLGWhiz again but code still don't work that I want.

Do you have any idea to corect my code in post #1?

 

[JLGWhiz]

Thanks @JLGWhiz again but code still don't work that I want.

Do you have any idea to corect my code in post #1?

Well, the code I suggested works, it just does not satisfy what you want it to do and I don't know off hand how to make it do that. Don't know anything about ADODB connections. Sorrry.
regards, JLG

 

[nhnn1986]

Many thanks for your respond./.