VBA-Copy/Paste Issue Excel 2013

[molinamike]

Hello Members,

I have a file that is imported to my C:Drive from a company system; however, I am only able to import using a xls extension. The imported file exceeds the maximum rows for xls; therefore, it creates additionally data tabs. I need the file to be in xlsx format all in one sheet. Is there any code that will copy all data from each tab from a closed xls file and then open a new xlsx file and paste all of the data into one worksheet? I have to do this with 17 files so I am trying to automate this process. I have searched the board but have not found a solution that would fit my scenario. Thanks for any assistance the board can provide.

~Thanks
Mike

 

[Fluff]

How about

Sub AddData()
' molinamike

    Dim NewSht As Worksheet
    Dim OrigWbk As Workbook
    Dim Ws As Worksheet
    
Application.ScreenUpdating = False

    Workbooks.Add (1)
    Set NewSht = ActiveSheet
    Set OrigWbk = Workbooks.Open("[COLOR=#ff0000]C:\Users\Fluff\Documents\Excel files\ZZ2.xls[/COLOR]")
    
    For Each Ws In OrigWbk.Sheets
        Ws.Range("A1").CurrentRegion.Copy NewSht.Range("A" & Rows.Count).End(xlUp).Offset(1)
    Next Ws
    OrigWbk.Close False
    NewSht.Rows(1).Delete
    
End Sub

Change the part in red to match your path/filename

 

[molinamike]

Thank you for the response. I attempted the code you provided; however, I received a debug error stating "We can't paste because the Copy Area and Paste Area aren't the same size"

How about

Sub AddData()
' molinamike

    Dim NewSht As Worksheet
    Dim OrigWbk As Workbook
    Dim Ws As Worksheet
    
Application.ScreenUpdating = False

    Workbooks.Add (1)
    Set NewSht = ActiveSheet
    Set OrigWbk = Workbooks.Open("[COLOR=#ff0000]C:\Users\Fluff\Documents\Excel files\ZZ2.xls[/COLOR]")
    
    For Each Ws In OrigWbk.Sheets
        Ws.Range("A1").CurrentRegion.Copy NewSht.Range("A" & Rows.Count).End(xlUp).Offset(1)
    Next Ws
    OrigWbk.Close False
    NewSht.Rows(1).Delete
    
End Sub

Change the part in red to match your path/filename

 

[Fluff]

Any idea approx how many rows of data you have in total?

 

[molinamike]

There is approx. 320,000 in this file most others are around 130,000.

Any idea approx how many rows of data you have in total?

 

[Fluff]

This might help

Sub AddData()
' molinamike

    Dim NewSht As Worksheet
    Dim OrigWbk As Workbook
    Dim Ws As Worksheet
    
Application.ScreenUpdating = False

    Workbooks.Add (1)
    Set NewSht = ActiveSheet
    Set OrigWbk = Workbooks.Open("C:\Users\Fluff\Documents\Excel files\ZZ2.xls")
    NewSht.Activate
    For Each Ws In OrigWbk.Sheets
        Ws.Range("A1").CurrentRegion.Copy NewSht.Range("A" & Rows.Count).End(xlUp).Offset(1)
    Next Ws
    OrigWbk.Close False
    NewSht.Rows(1).Delete
    
End Sub

The only way I could replicate the error message, is if there were over 1,048,576 rows, but that is obviously not the case.
I'm off down the pub now, so will have another look at this tomorrow.

 

[Fluff]

If you create a new workbook (Ie hit Ctrl+N) Does it open as Book1 - Excel or Book1 [Compatability Mode] - Excel