VBA Copy Multiple Sheets Data to Binary File

[unknownymous]

Hi Guys,


I have excel reference file named as Monthlies xxxx.xls format. Note that xxxx = date which changes every week. The file has 6 Tabs (Sheet 1-6). I need to convert the file first in binary then consolidated Sheet 1-5 on Sheet 1 as it normally consists of 300K lines when combined but I can't find any relevant code so I was thinking save a blank binary excel file on my desktop which will serve as the template.

Is there any easy way on how can I consolidate the 5 sheet tabs from the reference file and copy it to the binary excel template, replicate and rename the same as the reference file?




Any help will be much appreciated


Thank you!

 

[Logit]

.

Here is one method, of which there are many ...


This macro will condense all sheets in workbook to a new sheet :

Option Explicit


Function LastRow(sh As Worksheet)
    On Error Resume Next
    LastRow = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
    On Error GoTo 0
End Function


Function LastCol(sh As Worksheet)
    On Error Resume Next
    LastCol = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByColumns, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Column
    On Error GoTo 0
End Function


Sub CopyRangeFromMultiWorksheets()
    Dim sh As Worksheet
    Dim DestSh As Worksheet
    Dim Last As Long
    Dim CopyRng As Range
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With


    ' Delete the summary sheet if it exists.
    Application.DisplayAlerts = False
    On Error Resume Next
    ActiveWorkbook.Worksheets("WorkbookMergeSheet").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True


    ' Add a new summary worksheet.
    Set DestSh = ActiveWorkbook.Worksheets.Add
    DestSh.Name = "WorkbookMergeSheet"


    ' Loop through all worksheets and copy the data to the
    ' summary worksheet.
        


    For Each sh In ActiveWorkbook.Worksheets
        If sh.Name <> DestSh.Name Then


            ' Find the last row with data on the summary worksheet.
            Last = LastRow(DestSh)


            ' Specify the range to place the data.
            Set CopyRng = sh.Range("A1:T1")


            ' Test to see whether there are enough rows in the summary
            ' worksheet to copy all the data.
            If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
                MsgBox "There are not enough rows in the " & _
                   "summary worksheet to place the data."
                GoTo ExitTheSub
            End If


            ' This statement copies values and formats from each
            ' worksheet.
            Set CopyRng = sh.UsedRange
            CopyRng.Copy
            With DestSh.Cells(Last + 1, "A")
                .PasteSpecial xlPasteValues
                .PasteSpecial xlPasteFormats
                Application.CutCopyMode = False
            End With


            ' Optional: This statement will copy the sheet
            ' name in the H column.
            'DestSh.Cells(Last + 1, "H").Resize(CopyRng.Rows.Count).Value = sh.Name


        End If
    Next


ExitTheSub:


    Application.Goto DestSh.Cells(1)


    ' AutoFit the column width in the summary sheet.
    DestSh.Columns.AutoFit


    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

 

[Logit]

.
If the macro works for you, we can progress to the other steps from there.

 

[unknownymous]

Hi Logit,

I tried your codes but I am getting a "Run-time error '1004'" - The information cannot be pasted because the copy area and the paste area are not the same size and shape.

I guess because Original File is in 2003 format and per sheet tab consists of 50K Lines so I guess we can't merge that easily as the file is too big. I was thinking maybe we can open the Binary File and paste each Sheet from the Reference file. Also, can we add codes not to copy the header (row A) on the succeeding 5 sheets as it is existing in Sheet 1.


Thanks for the help.

 

[Logit]

.
If you have more rows in all sheets that can fit within a single sheet .... I don't know of anything that can change that.

The macro to convert your existing .xls file to .xlsb is :

Option Explicit


'Paste this macro inside the workbook to be converted.
'Edit the path and file name as required.


Sub Convrt()
    
    ActiveWorkbook.SaveAs "C:\Users\My\Desktop\ValuesLessThan.xlsb", FileFormat:=50
End Sub

 

[unknownymous]

This is helpful. Is there any way where the converted file is renamed as original file?

 

[Logit]

.
????????

When saving the file, it shouldn't be changing names. Just the extension will change.

 

[unknownymous]

Got it now! Thanks.

 

[Logit]

.
You are welcome.

 

[unknownymous]

One last thing Logit, on the macro that will condensed sheet. What if I want to exclude Sheet6, how can you do that? Thanks again in advance.