VBA Copy Multiple Sheets Data to Binary File

unknownymous

Board Regular
Joined
Sep 19, 2017
Messages
249
Office Version
  1. 2016
Platform
  1. Windows
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!
 

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).
.

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


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


Code:
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
 
Upvote 0
.
If the macro works for you, we can progress to the other steps from there.
 
Upvote 0
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. :)
 
Last edited:
Upvote 0
.
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 :

Code:
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
 
Upvote 0
This is helpful. Is there any way where the converted file is renamed as original file?
 
Upvote 0
.
????????

When saving the file, it shouldn't be changing names. Just the extension will change.
 
Upvote 0
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.
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,256
Members
448,557
Latest member
richa mishra

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top