VBA copy sheet to new workbook multiple time

hajiali

Active Member
Joined
Sep 8, 2018
Messages
388
Office Version
  1. 2016
Platform
  1. Windows
hello needing to copy sheet to a new workbook multiple times.

With each sheet in the new workbook the value in K1 is a date in "DDDD, MMMM DD, YYYY" Format needs to add 1. naming each sheet the K1 value in MM-DD format.
would like the code to duplicate till the last day of the month in K1. any help is greatly appreciated

RSS New Exception Log Layout.xlsm
ABCDEFGHIJK
1Tuesday, December 1, 2020
2EE#LAST NAMEFIRST NAMEPT/FT STATUSSCHEDULEACTUALOTDTMDTSUP INITIALREMARKS
31234KOREKURDFT 
412345JOHNSMITHFT 
5123456PAULSMITHFT 
66548CHRISHALLFT 
724568TONYWHITEFT 
835483JAMESBLACKFT 
02
Cell Formulas
RangeFormula
E3E3=IFERROR(IF(L$1=TRUE,INDEX('RSS BID'!$D$3:$J$102,MATCH(A3,'RSS BID'!$A$3:$A$102,0),MATCH(O1,'RSS BID'!$D$2:$J$2,0)),IF($M$1=TRUE,INDEX('RSS BID'!$L$3:$R$102,MATCH(A3,'RSS BID'!$A$3:$A$102,0),MATCH(O1,'RSS BID'!$L$2:$R$2,0)),"")),"")
E4E4=IFERROR(IF(L$1=TRUE,INDEX('RSS BID'!$D$3:$J$102,MATCH(A4,'RSS BID'!$A$3:$A$102,0),MATCH(O1,'RSS BID'!$D$2:$J$2,0)),IF($M$1=TRUE,INDEX('RSS BID'!$L$3:$R$102,MATCH(A4,'RSS BID'!$A$3:$A$102,0),MATCH(O1,'RSS BID'!$L$2:$R$2,0)),"")),"")
E5E5=IFERROR(IF(L$1=TRUE,INDEX('RSS BID'!$D$3:$J$102,MATCH(A5,'RSS BID'!$A$3:$A$102,0),MATCH(O1,'RSS BID'!$D$2:$J$2,0)),IF($M$1=TRUE,INDEX('RSS BID'!$L$3:$R$102,MATCH(A5,'RSS BID'!$A$3:$A$102,0),MATCH(O1,'RSS BID'!$L$2:$R$2,0)),"")),"")
E6E6=IFERROR(IF(L$1=TRUE,INDEX('RSS BID'!$D$3:$J$102,MATCH(A6,'RSS BID'!$A$3:$A$102,0),MATCH(O1,'RSS BID'!$D$2:$J$2,0)),IF($M$1=TRUE,INDEX('RSS BID'!$L$3:$R$102,MATCH(A6,'RSS BID'!$A$3:$A$102,0),MATCH(O1,'RSS BID'!$L$2:$R$2,0)),"")),"")
E7E7=IFERROR(IF(L$1=TRUE,INDEX('RSS BID'!$D$3:$J$102,MATCH(A7,'RSS BID'!$A$3:$A$102,0),MATCH(O1,'RSS BID'!$D$2:$J$2,0)),IF($M$1=TRUE,INDEX('RSS BID'!$L$3:$R$102,MATCH(A7,'RSS BID'!$A$3:$A$102,0),MATCH(O1,'RSS BID'!$L$2:$R$2,0)),"")),"")
E8E8=IFERROR(IF(L$1=TRUE,INDEX('RSS BID'!$D$3:$J$102,MATCH(A8,'RSS BID'!$A$3:$A$102,0),MATCH(O1,'RSS BID'!$D$2:$J$2,0)),IF($M$1=TRUE,INDEX('RSS BID'!$L$3:$R$102,MATCH(A8,'RSS BID'!$A$3:$A$102,0),MATCH(O1,'RSS BID'!$L$2:$R$2,0)),"")),"")
Cells with Conditional Formatting
CellConditionCell FormatStop If True
E3:E102Cell Valuecontains "OFF"textNO
 

Some videos you may like

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
10,239
Try:
VBA Code:
Sub CreateSheets()
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, x As Long, rDate As Date
    Set srcWS = ThisWorkbook.Sheets("Sheet1")
    rDate = srcWS.Range("K1")
    x = Day(Format(Excel.Application.WorksheetFunction.EoMonth(srcWS.Range("K1").Value2, 0), "yyyy-mm-dd"))
    Workbooks.Add 1
    For x = 0 To x - 1
        srcWS.Copy after:=Sheets(Sheets.Count)
        ActiveSheet.Name = Format(rDate + x, "mm-dd")
        Range("K1") = Range("K1") + x
    Next x
    Application.DisplayAlerts = False
    Sheets(1).Delete
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub
 
Solution

hajiali

Active Member
Joined
Sep 8, 2018
Messages
388
Office Version
  1. 2016
Platform
  1. Windows
Thank you so much mumps that works great. I really appreciate this
 

hajiali

Active Member
Joined
Sep 8, 2018
Messages
388
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

if I wanted to add the following to save the new workbook in the file path and file name where would I the below code?

VBA Code:
 ActiveWorkbook.SaveAs Filename:= _
        "\\C:\books\" & Range("N4") & " " & Range("N5") & ".xlsx ", FileFormat _
        :=xlOpenXMLWorkbook, CreateBackup:=False
 

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
10,239
In which sheet are Range("N4") and Range("N5")?
 

hajiali

Active Member
Joined
Sep 8, 2018
Messages
388
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

they will be on all sheets in the new workbook. Range("N4") is just the month of the value in K1. but its being copied to all sheets.
 

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
10,239
Try:
VBA Code:
Sub CreateSheets()
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, x As Long, rDate As Date
    Set srcWS = ThisWorkbook.Sheets("Sheet1")
    rDate = srcWS.Range("K1")
    x = Day(Format(Excel.Application.WorksheetFunction.EoMonth(srcWS.Range("K1").Value2, 0), "yyyy-mm-dd"))
    Workbooks.Add 1
    For x = 0 To x - 1
        srcWS.Copy after:=Sheets(Sheets.Count)
        ActiveSheet.Name = Format(rDate + x, "mm-dd")
        Range("K1") = Range("K1") + x
    Next x
    Application.DisplayAlerts = False
    Sheets(1).Delete
    Application.DisplayAlerts = True
    ActiveWorkbook.SaveAs Filename:="C:\books\" & Range("N4") & " " & Range("N5") & ".xlsx", FileFormat:=51
    Application.ScreenUpdating = True
End Sub
 

hajiali

Active Member
Joined
Sep 8, 2018
Messages
388
Office Version
  1. 2016
Platform
  1. Windows
1606067844077.png

Keep getting the above error on the
VBA Code:
ActiveWorkbook.SaveAs Filename:="C:\books\" & Range("N4") & " " & Range("N5") & ".xlsx", FileFormat:=51

the workbook file name changes correctly but I am not even able to manually save it I get the following message

1606068163964.png
 

Attachments

  • 1606068103855.png
    1606068103855.png
    11.8 KB · Views: 2

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
10,239
There could be many reasons why this is happening and I'm not sure I have a solution for you. Try doing a little research into the problem or open a new thread describing the problem. Perhaps another Forum member with experience with this issue will be able to help you. :(
 

Watch MrExcel Video

Forum statistics

Threads
1,128,165
Messages
5,629,068
Members
416,363
Latest member
zaveedd

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
Top