Copy Data Range From 1 Workbook To Another

Re: Copy Data Range From 1 Workbook To Another

hi mutant,

adapt this code to your solution:

'extracted from J-Walk


Function GetFileList(FileSpec As String) As Variant
'   Returns an array of filenames that match FileSpec
'   If no matching files are found, it returns False


    Dim FileArray() As Variant
    Dim FileCount As Integer
    Dim FileName As String
    
    On Error GoTo NoFilesFound


    FileCount = 0
    FileName = Dir(FileSpec)
    If FileName = "" Then GoTo NoFilesFound
    
'   Loop until no more matching files are found
    Do While FileName <> ""
        FileCount = FileCount + 1
        ReDim Preserve FileArray(1 To FileCount)
        FileArray(FileCount) = FileName
        FileName = Dir()
    Loop
    GetFileList = FileArray
    Exit Function


'   Error handler
NoFilesFound:
    GetFileList = False
End Function


Sub UpdateSales()
    Dim p As String, x As Variant, myPath As String
    myPath = "C:\Documents and Settings\HP_Administrator\My Documents\My Excel\Nadia\"
    p = myPath & "*.xls"
    x = GetFileList(p)
    
    Select Case IsArray(x)
        Case True 'files found
            For i = LBound(x) To UBound(x)
            Select Case x(i) = ThisWorkbook.Name
            Case True
            'do nothing
            Case False
            Application.ScreenUpdating = False
            Workbooks.Open FileName:=myPath & x(i)
            ThisWorkbook.Sheets(1).Range("A65536").End(xlUp).Offset(1, 0) = Application.WorksheetFunction.Substitute(x(i), ".xls", "")
            Workbooks(x(i)).Sheets("Sheet1").Range("B8:R8").Copy ThisWorkbook.Sheets(1).Range("A65536").End(xlUp).Offset(0, 1)
            Application.DisplayAlerts = False
            Workbooks(x(i)).Close
            Application.DisplayAlerts = True
            End Select
            Application.ScreenUpdating = True
            Next i
        Case False 'no files found
            MsgBox "No matching files"
    End Select
End Sub

hope this helps

Re: Copy Data Range From 1 Workbook To Another

hi Nadia,

i have put comments on most important parts of the code,
have a look and ask me again which part you are not sure of.
btw, place this code in a normal module;
while yr output file is open click Alt+F11,
go to insert module
and paste the code there

Sub UpdateSales()
    Dim p As String, x As Variant, myPath As String
    
    
    myPath = "C:\Documents and Settings\HP_Administrator\My Documents\My Excel\Nadia\" ' customize this
    p = myPath & "*.xls"
    x = GetFileList(p)
    
    Select Case IsArray(x)
        Case True 'files found
            For i = LBound(x) To UBound(x)
            Select Case x(i) = ThisWorkbook.Name
            Case True
            'do nothing
            Case False
            Application.ScreenUpdating = False 'speed up code
            Workbooks.Open FileName:=myPath & x(i) 'open each source file
            ThisWorkbook.Sheets(1).Range("A65536").End(xlUp).Offset(1, 0) = Application.WorksheetFunction.Substitute(x(i), ".xls", "") 'filename in first column without ".xls "
            Workbooks(x(i)).Sheets("Sheet1").Range("B8:R8").Copy ThisWorkbook.Sheets(1).Range("A65536").End(xlUp).Offset(0, 1) 'copy range to the last available row of the output file
            Application.DisplayAlerts = False 'prevent alert showing when closing file
            Workbooks(x(i)).Close 'close the source file
            Application.DisplayAlerts = True 'return default setting
            End Select
            Application.ScreenUpdating = True 'return default setting
            Next i
        Case False 'no files found
            MsgBox "No matching files"
    End Select
End Sub

this code copies the range:

'copy range to the last available row of the output file
Workbooks(x(i)).Sheets("Sheet1").Range("B8:R8").Copy ThisWorkbook.Sheets(1).Range("A65536").End(xlUp).Offset(0, 1) 
'the offset means ofsetting 1 column from col A, ie. col B
'column A cointains the filenames from which the datas came from

also

'change this:
ThisWorkbook.Sheets(1) 
'to:
ThisWorkbook.Sheets("YourSheetName")
'if your default sheet is not sheet 1

you need not tamper with the Function, just costumize the above module.

feel free to ask

Re: Copy Data Range From 1 Workbook To Another

Dear Xlite,

I'm TQV1969 that you helped me in Sat. I've got the same situation and I've tried your code but it showed the error message "Compile error: Sub or Funtion not defined" and highlight yellow backgroud for "GetFileList" in your code. Is it one other code for that or excel's funtion originally?

Thanks.
TQV1969

Re: Copy Data Range From 1 Workbook To Another

hi tqv1969,

you have to use the code posted in my first post on this thread, it has a
"GetFileList" Function.

i assume you took a 'partial' code which i used to explain to Mutant?

Re: Copy Data Range From 1 Workbook To Another

Dear Xlite,

Yes, I took the second code only. I will try te first one. Thanks for your quick response.

Best regards,
TQV1969

Re: Copy Data Range From 1 Workbook To Another

Dear mutant /Xlite,

I've tried all code and modify to correct directory and sheet name but it showed "no matching file". Mutant: could you share how you fix it?
Thanks.

TQV1969

Re: Copy Data Range From 1 Workbook To Another

hi tqv1969,

the only reason i can think of is the folder path not specified correctly.
remember to put the "\" after the folder name...

let me know if still not working

Re: Copy Data Range From 1 Workbook To Another

Dear xlite,

I've tried with my dir as C:\Copy\ and change to Sheet2 for those Sheet(1) in your code. And it showed message again.
I've got the source file with data in Sheet2 and want to copy all sheet contents from each of them to final file in Sheet2 also.
Did I do some thing wrong?:crying:

Best regards,
TQV1969

Re: Copy Data Range From 1 Workbook To Another

Dear xlite,

It worked now b/c I changed dir name. I'm so.....but I dont know how to select all data cells in my Sheet2. Please help!

Best regards,
TQV1969

Re: Copy Data Range From 1 Workbook To Another

Dear xlite,

I can select all sheet now but one more issue is the second set of data didn't connect from the last row in out put file but ONE row right after that. So the second set of data overwrite on the previous one but leave first row left only and so on for those next files.
I'm sorry to border you so many times but I tried my best but It couldn't.:crying:

Best regards,
TQV1969

Re: Copy Data Range From 1 Workbook To Another

hi tqv1969,

this code extracted from above pastes the data one row below the last row:

Workbooks(x(i)).Sheets("Sheet1").Range("B8:R8").Copy ThisWorkbook.Sheets(1).Range("A65536").End(xlUp).Offset(0, 1) 'copy range to the last available row of the output file

can you show us yr code so we can analyse it?
thx

Re: Copy Data Range From 1 Workbook To Another

Dear xlite,

I've attached here the two workbooks with data I want to copy to Test.XLS and data from Sheet2 for all three files. The modified code is in Test.xls file.
You can see the result of the code in Sheet2 in Test.xls.
Btw,There are any issues if i copy different sheet name from different files to Test.xls and in that case what the code should be.

Many thanks again for your time with me:) I hope this time it work!
Best regards,
TQV1969

Re: Copy Data Range From 1 Workbook To Another

hi TQV1969,

i cleaned up yr source files coz of these few points:

1. you select from A5 although data start from A1,
so i use from A1

2. you have a non-data causing a blank row incl in the selection,
so i deleted the non-data.

3. you have intermittent merged cells in col A which may casue problems,
so i replaced them with ordinary cells.

i've got it working based on the cleaned source files, as they always say:
a good housekeeping keeps all the (excel) bugs away!

hope this helps

Re: Copy Data Range From 1 Workbook To Another

Dear xlite,

I've tested your new files and it worked. Many thanks Xlite.
But the issue to me that is I've got one macro to edit the raw sheet to clean one after I bring all raw sheets(Sheet2 in this case) orginally to one sheet.
That means I need to edit all of them one by one first and apply your code later to bring all reparate sheets to test.xls later. If that is the case, I must edit one by one manually before apply your code.
Do you have any other way to do the same as current code but bring original Sheet2 content to Test.xls?

I understand that the Good House Keeping will help but I can't avoid that b/c the resources file are big and a lot. Sorry I ask you again.

Best regards,
TQV1969