delete blank rows in workbook created by vba in another workbook

QuantumSquirrel

New Member
Joined
Apr 24, 2020
Messages
7
Office Version
  1. 365
Platform
  1. Windows
Hi all, this is driving me completely crazy, i'm far from a vba expert, hope you can help.

So I have a workbook open with the following code behind a form control button.
It's supposed to create,name & save a new workbook and copy a range to it from a sheet (with a frozen pane) called MOM no named wsI in the code (stands for method of manufacture), then remove any blank rows.
I cant get it to remove the blank rows, i get a variation of error messages based around subscript out of range. I mention the frozen panes because It did briefly in a flaky way when i played around with freezing/unfreezing panes, but not robust enough to rely on, then it stopped.
It seems that when i create & save the new workbook (wbo) it is the active workbook as it is ontop of the original & is in focus but if i add a message box to return name of active workbook it shows (wbi). But whatever i do to try to make the right sheet active at the right time it doesn't work.

I don't mind going about it an entirely different way if anyone can suggest, all i want is a new workbook with the blank rows removed.

Many thanks in advance

VBA Code:
Sub CopyToNewBook()

Dim wbI As Workbook, wbO As Workbook
Dim wsI As Worksheet, wsO As Worksheet
Dim loc As Range
Dim DateTime As String
Dim Spath As String
Dim User As String
Dim r As Range, rows As Long, i As Long
   
      
DateTime = Format(CStr(Now), "ddmmyyyy" & " " & "hhmmss")
Set loc = Range("k2") 'contains the filepath to save to
User = Environ("Username") & " " & "Backup" & " "
Spath = loc & "\" & User & DateTime

'~~> Source/Input Workbook
Set wbI = ThisWorkbook

'~~> Set the relevant sheet from where you want to copy
Set wsI = wbI.Sheets("Clipboard")

'~~> Destination/Output Workbook
Set wbO = Workbooks.Add

With wbO
        '~~> Set the relevant sheet to where you want to paste
        Set wsO = wbO.Sheets("Sheet1")

        '~~>. Save the file
        .SaveAs Filename:=Spath & ".XLSX", FileFormat:=56

        '~~> Copy the range
        wsI.Range("c1:eek:549").Copy

        '~~> Paste it in say Cell A1.
        wsO.Range("A1").PasteSpecial Paste:=xlPasteValues
       
        Application.CutCopyMode = False
       
               
    'remove blank rows
   
    Set r = wbO.Worksheets("Sheet1").Range("a1:m549")
    rows = r.rows.Count
    For i = rows To 1 Step (-1)
    If WorksheetFunction.CountA(r.rows(i)) = 0 Then r.rows(i).Delete
    Next
   
End With

End Sub
 
Last edited by a moderator:

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
.
This macro version seems to do what you are seeking ... placing the new workbook on the desktop. Of course you can always change
the location where to save for your purposes.

The only issue left is trying to open the new workbook. Error message of the file extension being incorrect. At the moment I don't have
time to work on it. Perhaps you can clear up the issue before I get back this afternoon ?

VBA Code:
Option Explicit

Sub CopyToNewBook()

Dim wbI As Workbook, wbO As Workbook
Dim wsI As Worksheet, wsO As Worksheet
Dim loc As Range
Dim DateTime As String
Dim Spath As String
Dim User As String
Dim r As Range, rows As Long, i As Long


DateTime = Format(CStr(Now), "ddmmyyyy" & " " & "hhmmss")
Set loc = Range("k2") 'contains the filepath to save to
User = Environ("Username") & " " & "Backup" & " "
Spath = loc & "\" & User & DateTime

'~~> Source/Input Workbook
Set wbI = ThisWorkbook

'~~> Set the relevant sheet from where you want to copy
Set wsI = wbI.Sheets("Clipboard")

'~~> Destination/Output Workbook
Set wbO = Workbooks.Add

With wbO
'~~> Set the relevant sheet to where you want to paste
Set wsO = wbO.Sheets("Sheet1")

'~~>. Save the file
.SaveAs Filename:=Spath & ".XLSX", FileFormat:=56

'~~> Copy the range
wsI.Range("A1:M50").Copy

'~~> Paste it in say Cell A1.
wsO.Range("A1").PasteSpecial Paste:=xlPasteValues

Application.CutCopyMode = False


'remove blank rows

Set r = wbO.Worksheets("Sheet1").Range("a1:m549")
rows = r.rows.Count
For i = rows To 1 Step (-1)
If WorksheetFunction.CountA(r.rows(i)) = 0 Then r.rows(i).Delete
Next
End With
End Sub
 
Upvote 0
Lol, I’ve been working on it for many hours and I think exhausted all avenues
Hope you can find some time to help as I need it for work on Monday
Thanks in advance
QS
 
Upvote 0
Not sure what you mean about new location, it saves to a location on c drive but that can be selected in the variable “loc”
It drops it on the desktop in front of the workbook that creates it, are you talking about changing that?
 
Upvote 0
Not sure what you mean about new location, it saves to a location on c drive but that can be selected in the variable “loc”
It drops it on the desktop in front of the workbook that creates it, are you talking about changing that?

No ... I was not suggesting any change in location. Just giving you a heads up where the new workbook would be after it is created and of course
suggesting you can change that location if you want to at any time. Not saying a change was necessary.

Now that I am back, I'll give it some more effort and see what I can do.
 
Upvote 0

Forum statistics

Threads
1,223,911
Messages
6,175,337
Members
452,637
Latest member
Ezio2866

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