Copy ActiveSheet to Closed Workbook

hajiali

Active Member
Joined
Sep 8, 2018
Messages
329
Office Version
  1. 2016
Platform
  1. Windows
with the below code. If cell H1=1 the macro will copy active sheet and create a new workbook. I am trying to achieve if H1 is not 1 then to copy active sheet the workbook that was created when H1=1 and paste it to the last sheet. the workbook will be closed. with the current code it just opens the workbook but does not copy it over.

VBA Code:
Sub chkDatesCopyDutyRoster1()
Dim ws As Worksheet, Sh As Worksheet, Owb As Workbook
Set ws = ActiveSheet
Set Sh = Sheets("RA BUILD")
If Sheets("Bid Results").Range("AR1") = True Then
    If DateSerial(ws.Range("J1").Value, ws.Range("G1").Value, ws.Range("H1").Value) < Sh.Range("B1").Value Or _
        DateSerial(ws.Range("J1").Value, ws.Range("G1").Value, ws.Range("H1").Value) > Sh.Range("I1").Value Then
        MsgBox "CHANGE THE DATE OF THE LAST DAY OF BID IN SHEET BID RESULTS TO CONTUINE EXPORT"
        Exit Sub
    End If
ElseIf Sheets("Bid Results").Range("AR1") = False Then
    If DateSerial(ws.Range("J1").Value, ws.Range("G1").Value, ws.Range("H1").Value) < Sh.Range("AT1").Value Or _
        DateSerial(ws.Range("J1").Value, ws.Range("G1").Value, ws.Range("H1").Value) > Sh.Range("BA1").Value Then
        MsgBox "CHANGE THE DATE OF THE LAST DAY OF BID IN SHEET BID RESULTS TO CONTUINE EXPORT"
        Exit Sub
    End If
End If
Dim wb As Workbook
Set ws = ActiveSheet
If Range("H1") = 1 Then
ws.Unprotect Password:="password"
ws.Copy
ws.Protect Password:="password"
With ActiveWorkbook
ws.Cells.Copy .Sheets(1).Range("A1")
    ActiveWorkbook.SaveAs fileName:= _
        "C:\Schedule\" & Range("I1") & " " & "SCH & EL" & ".xlsx", FileFormat _
        :=xlOpenXMLWorkbook, CreateBackup:=False
End With
Call FormulaToValue
ActiveSheet.Name = Range("H1")
ws.Protect Password:="password"
ActiveWorkbook.Save
    Else
    Dim ws1 As Worksheet, wb2 As Workbook
    Application.ScreenUpdating = False
    Set wb1 = ActiveSheet
    wb1.Unprotect Password:="password"
        Set wb2 = Workbooks.Open(" C:\ Schedule\" & Range("I1") & " " & "SCH & EL" & ".xlsx")
            wb1.Sheets("BASE SCH").Copy After:=wb2.Sheets(wb2.Sheets.Count)
    Application.ScreenUpdating = True
Call FormulaToValue
ActiveSheet.Name = Range("H1")
ws.Protect Password:="password"
ActiveWorkbook.Save
End If
End Sub
 

Some videos you may like

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).

sijpie

Well-known Member
Joined
Nov 1, 2008
Messages
3,734
Put this in your code to replace the If/Else/End if section. Check the comments I made. You need to learn to be consistent . Set variables to the various workbooks involved and to the sheets you use. Else you'll end up with a muddle and things get copied to the wrong sheets or wrong workbooks.

The code below still is not really good. All of a sudden you use wb1.Sheets("BASE SCH") where before you were referring to ws1 set to the activesheet. If range H1 is always on the sheet Base SCH then at the start of the code set ws1 = wb1.Sheets("BASE SCH"). That makes it foolproof.

And put comments in your code to remind yourself what you are doing!

And use consistent indentation like I show below. It makes your code a lot easier to read (and maintain)

VBA Code:
    Dim wbC As Workbook
    
    Application.ScreenUpdating = False
    If ws.Range("H1") = 1 Then              ' put ws in front of Range(H1)
        ws.Unprotect Password:="password"
        ws.Copy
        ws.Protect Password:="password"
'        With ActiveWorkbook                 '<<< try to avoid 'Activeworkbook' or 'Activesheet' _
'                at some point you will lose track of what is active.
        Set wbC = ActiveWorkbook     'set to created copy
        With wbC
            ws.Cells.Copy .Sheets(1).Range("A1")
            .SaveAs _
                    Filename:="C:\Schedule\" & Range("I1") & " " & "SCH & EL" & ".xlsx", _
                    FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
            .Sheets(1).Name = Range("H1")
        End With
        Call FormulaToValue
'        ws.Protect Password:="password"        '<< you already have done this above
        wbC.Save
    Else
'        Dim ws1 As Worksheet, wb2 As Workbook  'you don't need more variables, you already have declared them above
'        Set ws1 = ActiveSheet                  'you already have set ws to the active sheet above
        wb1.Unprotect Password:="password"
        Set wbC = Workbooks.Open(" C:\ Schedule\" & Range("I1") & " " & "SCH & EL" & ".xlsx")
        wb1.Sheets("BASE SCH").Copy After:=wbC.Sheets(wb2.Sheets.Count)
        ActiveSheet.Name = Range("H1")
        Call FormulaToValue
        ws.Protect Password:="password"
        wbC.Close Savechanges:=True
    End If
    Application.ScreenUpdating = True
 

hajiali

Active Member
Joined
Sep 8, 2018
Messages
329
Office Version
  1. 2016
Platform
  1. Windows
Thanks for all the tips.

getting Run-Time Error "424"
Object requied for the following line

VBA Code:
wb1.Unprotect Password:="password"
 

sijpie

Well-known Member
Joined
Nov 1, 2008
Messages
3,734
You would have got that message in your original code as well, because wb1 is not set to any workbook.

I am not sure if the workbook running the code is the same as the workbook from which the sheet is being copied.

If so, then at the start of your code you can set wb1 to the ThisWorkbook object
VBA Code:
set wb1 = ThisWorkbook
. Else, if the workbook running the code is not the same as where the original sheet is held, you need to set it to that workbook
 

hajiali

Active Member
Joined
Sep 8, 2018
Messages
329
Office Version
  1. 2016
Platform
  1. Windows
Thanks for all your help. So far this opens the other workbook however it does not seem to be going through
VBA Code:
wb1.Sheets("BASE SCH").Copy After:=wbC.Sheets(wb2.Sheets.Count)
nothing is being copied over and not getting any error messages. not sure what I could be missing.
 

Watch MrExcel Video

Forum statistics

Threads
1,118,120
Messages
5,570,296
Members
412,318
Latest member
angoeyuan
Top