Automated Daily Production Report - Excel

[chadgaspard]

I am in need of a vba module that would allow me to do the following:

I currently have a workbook which is Titled "Aspen DPR 10-19". The "10-19" changes based off of current month-year. This Daily Production Report has a tab titled "Monthly Report" and also has a tab for each day of the month simply titled; "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16" "17", "18", "19", "20", "21", "22", "23", "24, "25", "26", "27", "28", "29", "30", "31", and the last tab is "1". "1" represents the 1st day of the upcoming month.

I need vba code for a Button named "Transfer to New Month", which I already have on worksheet "1", that would copy all tabs, open a new workbook, and paste all tabs into the new workbook, but add or take away tabs based off how many days are in that upcoming month. I also need it to rename the date in cell range C4:D4 to the second day of the upcoming month (e.g. 11/2/19).

I also need vba code for a button I already have on each sheet titled "Transfer Well Test" that would copy all data from the current active worksheet section (cell range A43 through N49) and paste this data into the exact spot on the rest of the numbered worksheets (not the sheet titled "Monthly Report"), but done so based off of the number of days (tabs) for the current month - and transfer that same data to next months report (all numbered tabs from Tab "2" to Tab "1".

Is this possible? If so this would save me hours of copy and pasting and minimize mistakes made by human error. Thanks in advance.

 

[MoshiM]

In addition, when I click the "Transfer To New Month" button on the last sheet (1) I would like the well test data to transfer to all pages in the new workbook that was copied from the active workbook along with the macros. If the upcoming months have more days, or less days, I would like it to adjust accordingly. By adjust accordingly I mean paste the correct number of sheets for the upcoming month and paste the well test data into all of the numbered sheets that represent a day. I don't want it to paste into the Monthly Report Sheet though because it does not contain cells to capture well test data.
​

"New_Monthly_Workbook" will now only run if "Transfer_Well_Test" is ran while on sheet "1"

Sub Transfer_Well_Test()


'SAVE BEFORE USING THIS TO MAKE SURE IT DOES WHAT YOU WANT PROPERLY


Dim WS As Worksheet, Starting_Worksheet As Long, Original_Worksheet As Worksheet, Range_Data As Range


'Day_Number = Date - DateSerial(Year(Date), Month(Date), 1) + 1 'day number


Set Original_Worksheet = ActiveWorkbook.ActiveSheet


With Original_Worksheet
     
    If IsNumeric(.Name) Then
             
        If CLng(.Name) <= 31 Then
            Set Range_Data = .Range("A43:N43") 'store this range in a variable
        Else
            MsgBox "Invalid worksheet day"
        
            End 'exit all subs        End If
        End If
        
    Else
    
        MsgBox "Invalid starting sheet"
        
        End 'exit all subs
        
    End If
    
End With


If Original_Worksheet.Name <> "1" Then  'if not running the macro from sheet "1"
                                        'then apply range to all other valid sheets
    For Each WS In ActiveWorkbook.Worksheets 'loop through worksheets
    
        With WS
    
            If Not WS Is Original_Worksheet And IsNumeric(.Name) Then
    
                If (CLng(.Name) > CLng(Original_Worksheet.Name) Or CLng(.Name) = 1) And CLng(.Name) <= 31 Then .Range(Range_Data.Address) = Range_Data
    
            End If
    
        End With
    
    Next


Else 'IF on sheet "1" then create a new workbook and apply range from sheet 1 to all
     'other valid worksheets in the new workbok
    
    Call New_Monthly_Workbook(Range_Data)


End If


End Sub
Sub New_Monthly_Workbook(RRR As Range) 'This sub is run from worksheet "1"


Dim Target_Month_Days, Target_Month_Day_1 As Date, X As Long, WS1 As Worksheet, New_WB As Workbook, _
FileN As String, ERR_WS As Worksheet, New_WS As Worksheet, SHP As Shape
 
Target_Month_Day_1 = DateSerial(Year(Date), Month(Date) + 1, 1) 'first day of next month


'Target_Month_Day_1 = DateSerial(2019, 12, 1) 'first day of Target Month if needed


Target_Month_Days = DateSerial(Year(Target_Month_Day_1), Month(Target_Month_Day_1) + 1, 1) - Target_Month_Day_1
                    
'first day of (Target_Month_Day_1 + 1 MONTH) - Target_Month_Day_1 = number of days in Tareget Month


Application.EnableEvents = False


Set New_WB = Workbooks.Add 'create new workbook and store object in a variable


Set WS1 = New_WB.Worksheets(1) 'first worksheet of the newly created workbook


CopyModules ThisWorkbook, New_WB


On Error Resume Next


For X = 1 To Target_Month_Days 'loop 1 to the number of days found in the target month


    Set ERR_WS = ThisWorkbook.Worksheets(CStr(X)) 'this will generate an error if it doesn't exist
    
    If Err.Number = 0 Then 'if the worksheet exists then copy it to the new Workbook
        
        If X = 1 Then
            ERR_WS.Copy After:=WS1
            Set New_WS = New_WB.Workbooks(WS1.Index + 1)
        Else
            ERR_WS.Copy Before:=WS1
            Set New_WS = New_WB.Workbooks(WS1.Index - 1)
        End If
        
        For Each SHP In New_WS.Shapes 'change macro reference of shapes to reference the newly created workbook
            SHP.OnAction = Replace(SHP.OnAction, ThisWorkbook.Name, New_WB.Name)
        Next SHP
        
    Else 'If it doesn't exit then create it within the new workbook, rename it and apply the stored range values
        
        With New_WB.Worksheets.Add
        
            .Move Before:=WS1
            .Name = CStr(X)
            
            Set New_WS = New_WB.Workbooks(WS1.Index - 1)
            
        End With
        
        Err.Clear 'clear the generated error
        
    End If
    
    If X > 1 Then New_WS.Range(RRR.Address) = RRR 'apply range from sheet "1"


Next X


With New_WB


    ThisWorkbook.Worksheets("Monthly Report").Copy Before:=.Worksheets(1) 'Copy Monthly Report to new Worksheet
    
    .Worksheets("2").Range("C4:D4") = Target_Month_Day_1 + 1 'second day of the next month


    .Worksheets("Monthly Report").Range("B10") = Target_Month_Day_1 'First Day of upcoming Month
    
End With


With Application


    .EnableEvents = True
    
    .DisplayAlerts = False
            WS1.Delete
    .DisplayAlerts = True
    
End With


FileN = ThisWorkbook.Path & "\" & "Aspen DPR " & Month(Target_Month_Day_1) & "-" & Mid(Year(Target_Month_Day_1), 3, 2) & ".xlsb"


New_WB.SaveAs Filename:=FileN, FileFormat:=xlExcel12


End Sub
Sub CopyModules(wbSource As Workbook, wbTarget As Workbook)


Dim vbcompSource As VBComponent, vbcompTarget As VBComponent


Dim sText As String, nType As Long


For Each vbcompSource In wbSource.VBProject.VBComponents
    nType = vbcompSource.Type
    If nType < 100 Then '100=vbext_ct_Document -- the only module type we would not want to copy
        Set vbcompTarget = wbTarget.VBProject.VBComponents.Add(nType)
        sText = vbcompSource.CodeModule.Lines(1, vbcompSource.CodeModule.CountOfLines)
        vbcompTarget.CodeModule.AddFromString (sText)
        vbcompTarget.Name = vbcompSource.Name
    End If
Next vbcompSource


End Sub

 

[chadgaspard]

I think may have taken a step backwards. This is probably my fault for not knowing the correct vba verbiage. In terms of relationship to the creation of a new workbook from the existing active workbook, the "New Monthly Workbook" or "Month_Stuff" script as you previously reffered to it can't rely on the well test data transfer because a new well test may not be run on the 1st of the month. The Well Test data should just simply carry over from the active workbook "1" worksheet to the "2" through "31" (December for example) worksheets in the newly created workbook. Along with all of the other commands previously discussed. This will be assigned to a button, which is located only on worksheet titled "1". This button is located only on this sheet and is separate from the "Transfer Well Test Data" button.

In terms of stand alone Well Test Data Transfer from one sheet within the active workbook (current month) to all days going forward in the same active workbook (current month), this should be an entirely different macro which be assigned to an entirely different button which is present on all sheets representing a day of the month.

 

[MoshiM]

I think may have taken a step backwards. This is probably my fault for not knowing the correct vba verbiage. In terms of relationship to the creation of a new workbook from the existing active workbook, the "New Monthly Workbook" or "Month_Stuff" script as you previously reffered to it can't rely on the well test data transfer because a new well test may not be run on the 1st of the month. The Well Test data should just simply carry over from the active workbook "1" worksheet to the "2" through "31" (December for example) worksheets in the newly created workbook. Along with all of the other commands previously discussed. This will be assigned to a button, which is located only on worksheet titled "1". This button is located only on this sheet and is separate from the "Transfer Well Test Data" button.

In terms of stand alone Well Test Data Transfer from one sheet within the active workbook (current month) to all days going forward in the same active workbook (current month), this should be an entirely different macro which be assigned to an entirely different button which is present on all sheets representing a day of the month.

For the previous macro I posted, Well_Test_Data would DO different things depending on whether or not it was called while on sheet "1". If not called while on sheet "1" then it would copy the specified range and place it on all worksheets starting on the current sheet +1 to the end of the numbered worksheets and then include "1" at the end.

If called from while on sheet "1" it would copy the needed worksheets to a new workbook and then overwrite the specified range on each valid worksheet with the range found on sheet "1".

With the following, the actions of the two scripts are no longer linked under the same macro

Well Transfer_Well_Test will do the same thing if called from a valid worksheet and New_Monthly_Workbook will copy the range found on sheet "1" to the other valid sheets when the new workbook is created.

Sub Transfer_Well_Test()

'SAVE BEFORE USING THIS TO MAKE SURE IT DOES WHAT YOU WANT PROPERLY

Dim WS As Worksheet, Starting_Worksheet As Long, Original_Worksheet As Worksheet, Range_Data As Range

'Day_Number = Date - DateSerial(Year(Date), Month(Date), 1) + 1 'day number

Set Original_Worksheet = ActiveWorkbook.ActiveSheet

With Original_Worksheet
   
    If IsNumeric(.Name) Then
             
        If CLng(.Name) <= 31 Then
            Set Range_Data = .Range("A43:N43") 'store this range in a variable
        Else
            MsgBox "Invalid worksheet day"
        
            End 'exit all subs        End If
        End If
        
    Else
    
        MsgBox "Invalid starting sheet"
        
        End 'exit all subs
        
    End If
    
End With
                                        'Then apply range to all other valid worksheets
For Each WS In ActiveWorkbook.Worksheets 'loop through worksheets

    With WS

        If Not WS Is Original_Worksheet And IsNumeric(.Name) Then

            If (CLng(.Name) > CLng(Original_Worksheet.Name) Or CLng(.Name) = 1) And CLng(.Name) <= 31 Then .Range(Range_Data.Address) = Range_Data

        End If

    End With

Next WS

End Sub
Sub New_Monthly_Workbook() 'This sub is run from worksheet "1"

Dim Target_Month_Days, Target_Month_Day_1 As Date, X As Long, WS1 As Worksheet, New_WB As Workbook, _
FileN As String, ERR_WS As Worksheet, New_WS As Worksheet, SHP As Shape, RRR As Range
 
Target_Month_Day_1 = DateSerial(Year(Date), Month(Date) + 1, 1) 'first day of next month

'Target_Month_Day_1 = DateSerial(2019, 12, 1) 'first day of Target Month if needed

Target_Month_Days = DateSerial(Year(Target_Month_Day_1), Month(Target_Month_Day_1) + 1, 1) - Target_Month_Day_1
                    
'first day of (Target_Month_Day_1 + 1 MONTH) - Target_Month_Day_1 = number of days in Tareget Month

Application.EnableEvents = False

Set New_WB = Workbooks.Add 'create new workbook and store object in a variable

Set WS1 = New_WB.Worksheets(1) 'first worksheet of the newly created workbook

CopyModules ThisWorkbook, New_WB

On Error Resume Next

For X = 1 To Target_Month_Days 'loop 1 to the number of days found in the target month

    Set ERR_WS = ThisWorkbook.Worksheets(CStr(X)) 'this will generate an error if it doesn't exist
    
    If Err.Number = 0 Then 'if the worksheet exists then copy it to the new Workbook
        
        If X = 1 Then
            ERR_WS.Copy After:=WS1
            Set New_WS = New_WB.Workbooks(WS1.Index + 1)
            Set RRR = New_WS.Range("A43:N43")
        Else
            ERR_WS.Copy Before:=WS1
            Set New_WS = New_WB.Workbooks(WS1.Index - 1)
        End If
        
        For Each SHP In New_WS.Shapes 'change macro reference of shapes to reference the newly created workbook
            SHP.OnAction = Replace(SHP.OnAction, ThisWorkbook.Name, New_WB.Name)
        Next SHP
        
    Else 'If it doesn't exit then create it within the new workbook, rename it and apply the stored range values
        
        With New_WB.Worksheets.Add
        
            .Move Before:=WS1
            .Name = CStr(X)
            
            Set New_WS = New_WB.Workbooks(WS1.Index - 1)
            
        End With
        
        Err.Clear 'clear the generated error
        
    End If
    
    If X > 1 Then New_WS.Range(RRR.Address) = RRR 'apply range from sheet "1"

Next X

With New_WB

    ThisWorkbook.Worksheets("Monthly Report").Copy Before:=.Worksheets(1) 'Copy Monthly Report to new Worksheet
    
    .Worksheets("2").Range("C4:D4") = Target_Month_Day_1 + 1 'second day of the next month

    .Worksheets("Monthly Report").Range("B10") = Target_Month_Day_1 'First Day of upcoming Month
    
End With

With Application

    .EnableEvents = True
    
    .DisplayAlerts = False
            WS1.Delete
    .DisplayAlerts = True
    
End With

FileN = ThisWorkbook.Path & "\" & "Aspen DPR " & Month(Target_Month_Day_1) & "-" & Mid(Year(Target_Month_Day_1), 3, 2) & ".xlsb"

New_WB.SaveAs Filename:=FileN, FileFormat:=xlExcel12

End Sub
Sub CopyModules(wbSource As Workbook, wbTarget As Workbook)

Dim vbcompSource As VBComponent, vbcompTarget As VBComponent

Dim sText As String, nType As Long

For Each vbcompSource In wbSource.VBProject.VBComponents
    nType = vbcompSource.Type
    If nType < 100 Then '100=vbext_ct_Document -- the only module type we would not want to copy
        Set vbcompTarget = wbTarget.VBProject.VBComponents.Add(nType)
        sText = vbcompSource.CodeModule.Lines(1, vbcompSource.CodeModule.CountOfLines)
        vbcompTarget.CodeModule.AddFromString (sText)
        vbcompTarget.Name = vbcompSource.Name
    End If
Next vbcompSource

End Sub

 

[chadgaspard]

I re-recorded the Month_Stuff macro. Its just missing the ability to accurately add or take away sheets based off of days in the upcoming month as well as the ability to carry over the "Transfer_Well_Test" and Month_stuff" macros

Code:

[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Sub Month_stuff()
'
' Month_stuff Macro
'[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]'
Sheets(Array("Monthly Report", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", _
"13", "14", "15", "16", "17", "18", "19", "20", "21", "22", "23", "24", "1")).Select
Sheets("1").Activate
Sheets(Array("25", "26", "27", "28", "29", "30")).Select Replace:=False
Sheets(Array("Monthly Report", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", _
"13", "14", "15", "16", "17", "18", "19", "20", "21", "22", "23", "24", "1")).Select
Sheets("1").Activate
Sheets(Array("25", "26", "27", "28", "29", "30")).Select Replace:=False
Sheets(Array("Monthly Report", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", _
"13", "14", "15", "16", "17", "18", "19", "20", "21", "22", "23", "24", "25", "26", "27", "28" _
, "29", "30", "1")).Copy
Range("B10").Select
ActiveCell.FormulaR1C1 = "12/1/2019"
Range("B11").Select
Sheets("2").Select
Range("C4:D4").Select
ActiveCell.FormulaR1C1 = "='1'!R[2]C[16]"
Range("C5:D5").Select
ActiveWindow.SmallScroll Down:=30
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets("1").Select
ActiveWindow.SmallScroll Down:=27
Range("A47:N53").Select
Selection.Copy
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("2").Select
Range("A47:N53").Select
ActiveSheet.Paste
Sheets("3").Select
ActiveWindow.SmallScroll Down:=9
Range("A47:N53").Select
ActiveSheet.Paste
Sheets("4").Select
Range("A47:N53").Select
ActiveSheet.Paste
Sheets("5").Select
Range("A47:N53").Select
ActiveSheet.Paste
Sheets("6").Select
Range("A47:N53").Select
ActiveSheet.Paste
Sheets("7").Select
Range("A47:N53").Select
ActiveSheet.Paste
Sheets("8").Select
Range("A47:N53").Select
ActiveSheet.Paste
Sheets("9").Select
Range("A47:N53").Select
ActiveSheet.Paste
Sheets("10").Select
Range("A47:N53").Select
ActiveSheet.Paste
Sheets("11").Select
Range("A47:N53").Select
ActiveSheet.Paste
Sheets("12").Select
Range("A47:N53").Select
ActiveSheet.Paste
Sheets("13").Select
Range("A47:N53").Select
ActiveSheet.Paste
Sheets("14").Select
Range("A47:N53").Select
ActiveSheet.Paste
Sheets("15").Select
Range("A47:N53").Select
ActiveSheet.Paste
Sheets("16").Select
Range("A47:N53").Select
ActiveSheet.Paste
Sheets("17").Select
Range("A47:N53").Select
ActiveSheet.Paste
Sheets("18").Select
Range("A47:N53").Select
ActiveSheet.Paste
Sheets("19").Select
Range("A47:N53").Select
ActiveSheet.Paste
Sheets("20").Select
Range("A47:N53").Select
ActiveSheet.Paste
Sheets("21").Select
Range("A47:N53").Select
ActiveSheet.Paste
Sheets("22").Select
Range("A47:N53").Select
ActiveSheet.Paste
Sheets("23").Select
Range("A47:N53").Select
ActiveSheet.Paste
Sheets("24").Select
Range("A47:N53").Select
ActiveSheet.Paste
Sheets("25").Select
Range("A47:N53").Select
ActiveSheet.Paste
Sheets("26").Select
Range("A47:N53").Select
ActiveSheet.Paste
Sheets("27").Select
Range("A47:N53").Select
ActiveSheet.Paste
Sheets("28").Select
Range("A47:N53").Select
ActiveSheet.Paste
Sheets("29").Select
ActiveWindow.SmallScroll Down:=15
Range("A47:N53").Select
ActiveSheet.Paste
Sheets("30").Select
Range("A47:N53").Select
ActiveSheet.Paste
Sheets("30").Select
Application.CutCopyMode = False
Sheets("30").Copy Before:=Sheets(31)
Sheets("30 (2)").Select
Sheets("30 (2)").Name = "31"
ActiveWindow.SmallScroll Down:=-39
Range("C4:D4").Select
ActiveCell.FormulaR1C1 = "='30'!RC:RC[1]+1"
Range("C5:D5").Select
Sheets("1").Select
ActiveWindow.SmallScroll Down:=-45
Range("C4:D4").Select
ActiveCell.FormulaR1C1 = "='31'!RC:RC[1]+1"
Range("C5:D5").Select
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("Monthly Report").Select
Range("B10").Select
ActiveCell.FormulaR1C1 = "='1'!R[-4]C[17]-1"
Range("B11").Select
Sheets("2").Select
ActiveWindow.SmallScroll Down:=-12
End Sub
[/FONT]

 

[chadgaspard]

Tremendous thank you to MoshiM! This person was very patient and extremely helpful. Though I am very new to macros and still quite lost, I learned a lot in this process. Final code that made this happen:

"Transfer Well Test" within current month. Still needs work to make it execute more efficiently, but does it's job.

[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Sub Transfer_Well_Test() ' ' Transfer_Well_Test Macro '[/FONT] [FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]' Range("A47:N53").Select Selection.Copy Sheets("3").Select Range("A47:N53").Select ActiveSheet.Paste Sheets("4").Select Range("A47:N53").Select ActiveSheet.Paste Sheets("5").Select Range("A47:N53").Select ActiveSheet.Paste Sheets("6").Select Range("A47:N53").Select ActiveSheet.Paste Sheets("7").Select Range("A47:N53").Select ActiveSheet.Paste Sheets("8").Select Range("A47:N53").Select ActiveSheet.Paste Sheets("9").Select Range("A47:N53").Select ActiveSheet.Paste Sheets("10").Select Range("A47:N53").Select ActiveSheet.Paste Sheets("11").Select Range("A47:N53").Select ActiveSheet.Paste Sheets("12").Select Range("A47:N53").Select ActiveSheet.Paste Sheets("13").Select Range("A47:N53").Select ActiveSheet.Paste Sheets("14").Select Range("A47:N53").Select ActiveSheet.Paste Sheets("15").Select Range("A47:N53").Select ActiveSheet.Paste Sheets("16").Select Range("A47:N53").Select ActiveSheet.Paste Sheets("17").Select Range("A47:N53").Select ActiveSheet.Paste Sheets("18").Select Range("A47:N53").Select ActiveSheet.Paste Sheets("19").Select Range("A47:N53").Select ActiveSheet.Paste Sheets("20").Select Range("A47:N53").Select ActiveSheet.Paste Sheets("21").Select Range("A47:N53").Select ActiveSheet.Paste Sheets("22").Select Range("A47:N53").Select ActiveSheet.Paste Sheets("23").Select Range("A47:N53").Select ActiveSheet.Paste Sheets("24").Select Range("A47:N53").Select ActiveSheet.Paste Sheets("25").Select Range("A47:N53").Select ActiveSheet.Paste Sheets("26").Select Range("A47:N53").Select ActiveSheet.Paste Sheets("27").Select Range("A47:N53").Select ActiveSheet.Paste Sheets("28").Select Range("A47:N53").Select ActiveSheet.Paste Sheets("29").Select Range("A47:N53").Select ActiveSheet.Paste Sheets("30").Select Range("A47:N53").Select ActiveSheet.Paste ActiveWindow.ScrollWorkbookTabs Position:=xlLast Sheets("1").Select ActiveWindow.SmallScroll Down:=27 Range("A47:N53").Select ActiveSheet.Paste ActiveWindow.ScrollWorkbookTabs Position:=xlFirst Sheets("2").Select Application.CutCopyMode = False End Sub[/FONT] [FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Sub CopyModules(wbSource As Workbook, wbTarget As Workbook)[/FONT] [FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif] Dim vbcompSource As VBComponent, vbcompTarget As VBComponent[/FONT] [FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif] Dim sText As String, nType As Long[/FONT] [FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif] For Each vbcompSource In wbSource.VBProject.VBComponents nType = vbcompSource.Type If nType < 100 Then '100=vbext_ct_Document -- the only module type we would not want to copy Set vbcompTarget = wbTarget.VBProject.VBComponents.Add(nType) sText = vbcompSource.CodeModule.Lines(1, vbcompSource.CodeModule.CountOfLines) vbcompTarget.CodeModule.AddFromString (sText) vbcompTarget.Name = vbcompSource.Name End If Next vbcompSource[/FONT] [FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif] End Sub Sub Update_SITP() ' ' Update_SITP Macro '[/FONT] [FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]' Range("L39:N44").Select Selection.Copy Sheets("3").Select Range("L39:N40").Select ActiveSheet.Paste Sheets("4").Select Range("L39:N44").Select ActiveSheet.Paste Sheets("5").Select ActiveSheet.Paste Sheets("6").Select ActiveSheet.Paste Sheets("7").Select ActiveSheet.Paste Sheets("8").Select ActiveSheet.Paste Sheets("9").Select ActiveSheet.Paste Sheets("10").Select ActiveSheet.Paste Sheets("11").Select ActiveSheet.Paste Sheets("12").Select ActiveSheet.Paste Sheets("13").Select ActiveSheet.Paste Sheets("14").Select ActiveSheet.Paste Sheets("15").Select ActiveSheet.Paste Sheets("16").Select ActiveSheet.Paste Sheets("17").Select ActiveSheet.Paste Sheets("18").Select ActiveSheet.Paste Sheets("19").Select ActiveSheet.Paste Sheets("20").Select ActiveSheet.Paste Sheets("21").Select ActiveSheet.Paste Sheets("22").Select ActiveSheet.Paste Sheets("23").Select ActiveSheet.Paste Sheets("24").Select ActiveSheet.Paste Sheets("25").Select ActiveSheet.Paste Sheets("26").Select ActiveSheet.Paste Sheets("27").Select ActiveSheet.Paste Sheets("28").Select ActiveSheet.Paste Sheets("29").Select ActiveSheet.Paste Sheets("30").Select ActiveSheet.Paste Range("L39:N44").Select ActiveSheet.Paste ActiveWindow.SmallScroll Down:=9 Range("P48:R53").Select Application.CutCopyMode = False Selection.ClearContents With Selection.Interior .Pattern = xlNone .TintAndShade = 0 .PatternTintAndShade = 0 End With Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone Selection.Borders(xlEdgeLeft).LineStyle = xlNone Selection.Borders(xlEdgeTop).LineStyle = xlNone Selection.Borders(xlEdgeBottom).LineStyle = xlNone Selection.Borders(xlEdgeRight).LineStyle = xlNone Selection.Borders(xlInsideVertical).LineStyle = xlNone Selection.Borders(xlInsideHorizontal).LineStyle = xlNone Range("L39:N44").Select Selection.Copy Sheets("1").Select Range("L39:N44").Select ActiveSheet.Paste ActiveWindow.ScrollWorkbookTabs Position:=xlLast End Sub [/FONT] <strike></strike>

<tbody>
</tbody>

<strike></strike>

Prepare Next Month's Daily Production Report, move over latest Well Test Data, move over Macros, and Update Shut-in Tubing Pressure

[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Sub Month_Stuff()[/FONT] [FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif] Dim Target_Month_Days, Target_Month_Day_1 As Date, X As Long, WS1 As Worksheet, New_WB As Workbook, _ FileN As String, ERR_WS As Worksheet, RRR As Range Transfer_Well_Test RRR[/FONT] [FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif] Target_Month_Day_1 = DateSerial(Year(Date), Month(Date) + 1, 1) 'first day of next month[/FONT] [FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif] 'Target_Month_Day_1 = DateSerial(2019, 12, 1) 'first day of Target Month if needed[/FONT] [FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif] Target_Month_Days = DateSerial(Year(Target_Month_Day_1), Month(Target_Month_Day_1) + 1, 1) - Target_Month_Day_1 'first day of (Target_Month_Day_1 + 1 MONTH) - Target_Month_Day_1 = number of days in Tareget Month Set New_WB = Workbooks.Add 'create new workbook and store object in a variable[/FONT] [FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif] Set WS1 = New_WB.Worksheets(1) 'first worksheet of the newly created workbook[/FONT] [FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif] Application.EnableEvents = False[/FONT] [FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif] On Error Resume Next[/FONT] [FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif] For X = 1 To Target_Month_Days 'loop 1 to the number of days found in the target month[/FONT] [FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif] Set ERR_WS = ThisWorkbook.Worksheets(CStr(X)) 'this will generate an error if it doesn't exist If Err.Number = 0 Then 'if the worksheet exists then copy it to the new Workbook If X = 1 Then ERR_WS.Copy After:=WS1 Else ERR_WS.Copy Before:=WS1 End If Else 'If it doesn't exit then create it within the new workbook and rename it With New_WB.Worksheets.Add .Move Before:=WS1 .Name = CStr(X) .Range(RRR.Address) = RRR End With Err.Clear 'clear the generated error End If[/FONT] [FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif] Next X[/FONT] [FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif] With New_WB[/FONT] [FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif] ThisWorkbook.Worksheets("Monthly Report").Copy Before:=.Worksheets(1) 'Copy Monthly Report to new Worksheet .Worksheets("2").Range("C4:D4") = DateSerial(Year(Target_Month_Day_1), Month(Target_Month_Day_1), 2) 'second day of the next month[/FONT] [FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif] .Worksheets("Monthly Report").Range("B10") = DateSerial(Year(Target_Month_Day_1), Month(Target_Month_Day_1), 1) 'First Day of upcoming Month End With[/FONT] [FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif] With Application[/FONT] [FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif] .EnableEvents = True .DisplayAlerts = False WS1.Delete .DisplayAlerts = True End With CopyModules ThisWorkbook, New_WB[/FONT] [FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]FileN = ThisWorkbook.Path & "" & "Aspen DPR " & Month(Target_Month_Day_1) & "-" & Mid(Year(Target_Month_Day_1), 3, 2) & ".xlsb"[/FONT] [FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif] New_WB.SaveAs Filename:=FileN, FileFormat:=xlExcel12[/FONT] [FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif] End Sub[/FONT] [FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Sub Transfer_Well_Test(ByRef RR As Range)[/FONT] [FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif] 'SAVE BEFORE USING THIS TO MAKE SURE IT DOES WHAT YOU WANT PROPERLY[/FONT] [FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif] Dim WS As Worksheet[/FONT] [FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif] Set RR = ActiveWorkbook.ActiveSheet.Range("A47:N53") 'store this range in a variable[/FONT] [FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif] For Each WS In ActiveWorkbook.Worksheets With WS If Not WS Is ActiveWorkbook.ActiveSheet And IsNumeric(.Name) Then If CLng(.Name) <= 31 Then .Range("A47:N53") = RR End If End With Next[/FONT] [FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif] End Sub[/FONT] [FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Sub CopyModules(wbSource As Workbook, wbTarget As Workbook)[/FONT] [FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif] Dim vbcompSource As VBComponent, vbcompTarget As VBComponent Dim sText As String, nType As Long For Each vbcompSource In wbSource.VBProject.VBComponents nType = vbcompSource.Type If nType < 100 Then '100=vbext_ct_Document -- the only module type we would not want to copy Set vbcompTarget = wbTarget.VBProject.VBComponents.Add(nType) sText = vbcompSource.CodeModule.Lines(1, vbcompSource.CodeModule.CountOfLines) vbcompTarget.CodeModule.AddFromString (sText) vbcompTarget.Name = vbcompSource.Name End If Next vbcompSource End Sub[/FONT] [FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif][/FONT] <strike></strike>

<tbody>
</tbody>

<strike></strike>