Copy sheet from .xlsm to xlsx and rename copied sheet in xlsx to contents of a cell

[agentkramr]

Basically titler says it all, i have an xlsm that is retieving data from Oracle it waits for the refresh to occur, copies the page and should paste it to a workbook xlsx and name that page to the contents of a defined cell.

Sub Copy()
'Refresh Workbook
Workbooks("COUNT 2022").RefreshAll
'Open a workbook

  'Open method requires full file path to be referenced.
  Workbooks.Open "\\filepapth\TEST\2022 2 Week Count.xlsx"
  
  Workbooks("COUNT 2022.xlsm").Activate
  
  Sheets("New").Copy After:=Workbooks("2022 2 Week Count.xlsx").Sheets(Workbooks("2022 2 Week Count.xlsx").Sheets.Count)
    ActiveSheet.Range("A1:AC84").Copy
    ActiveSheet.Range("A1:AC84").PasteSpecial xlPasteValues
    'ActiveSheet.Shapes("Rectangle: Rounded Corners 1").Delete
    'ActiveSheet.Shapes("Rectangle: Rounded Corners 2").Delete
    Dim Val As String
    Val = Sheets("New").Range("AI1").Value
        
    'Columns("AF:AI").Delete

    ActiveWorkbook.Save
    ActiveWorkbook.Close
End Sub

everything works except renaming the sheet after the cell contents the contents is just todays date which is just named month then day( AUG 26). it still has the original sheet name and i get a runtime 1004 application defined or object defined error,
if i hit debug it takes me to the line

ActiveSheet.Name = Val

 

[agentkramr]

Replace this:

    'Copy sheet from "Copy-From" workbook to "Copy-To" workbook
    WB1.Sheets("2018 1 Hour Counts").Copy After:=WB2.Sheets(WB2.Sheets.Count)
    Set WS2 = WB2.Sheets(WB2.Sheets.Count)

    'Convert any formulas to values
    WS2.Range("A1:AC84").Value = WS2.Range("A1:AC84").Value

with this:

    'Copy sheet from "Copy-From" workbook to "Copy-To" workbook
    With WB1.Sheets("2018 1 Hour Counts")
        .Copy After:=WB2.Sheets(WB2.Sheets.Count)
        Set WS2 = WB2.Sheets(WB2.Sheets.Count)

        'Convert any formulas to values
         WS2.Range("A1:AC84").Value = .Range("A1:AC84").Value
    End With

ok working like a champ now ! one question though, is there way for it to not check if the workbook is open. I am summoning it with a script and the check for it being open cancels the script

 

[rlv01]

Sure just remove this:

    'Assign "Copy-From" workbook. Presumed to be already open
    On Error Resume Next
    Set WB1 = Application.Workbooks("COUNT 2022.xlsm")    ' "Copy-From" workbook
    On Error GoTo 0

    If WB1 Is Nothing Then
        MsgBox "Workbook :'" & "COUNT 2022.xlsm" & "' is not open", vbOKOnly Or vbExclamation, "Workbook not found"
        Exit Sub
    End If

But the trade-off is that the macro will crash if the workbook is not already open.

 

[agentkramr]

Sure just remove this:

    'Assign "Copy-From" workbook. Presumed to be already open
    On Error Resume Next
    Set WB1 = Application.Workbooks("COUNT 2022.xlsm")    ' "Copy-From" workbook
    On Error GoTo 0

    If WB1 Is Nothing Then
        MsgBox "Workbook :'" & "COUNT 2022.xlsm" & "' is not open", vbOKOnly Or vbExclamation, "Workbook not found"
        Exit Sub
    End If

But the trade-off is that the macro will crash if the workbook is not already open.

I left it in annotated out the debug check, all seems fantastic ! thank you so so so much for all of your help !

 

[rlv01]

Glad I could help.

 

[agentkramr]

Glad I could help.

i am getting an error on this now debug windows pops and takes me to

If WS2.Name = TmpStr Then

 

[rlv01]

No idea. If it was me, I'd begin by inspecting the live values for WS2.Name and TmpStr

 

[agentkramr]

No idea. If it was me, I'd begin by inspecting the live values for WS2.Name and TmpStr

got rid of the error but now it isnt pasting the values of the cells but the location of the cells within the copy and not naming the page of the contents of AI1, i dont understand how it went from working to non ... so weird

Sub CBTN_Copy()
    Dim WB1 As Workbook, WB2 As Workbook
    Dim WS As Worksheet, WS2 As Worksheet
    Dim Val As String, TmpStr As String, FilePath As String
    Dim DelCnt As Long

    'Assign "Copy-From" workbook. Presumed to be already open
    On Error Resume Next
    Set WB1 = Application.Workbooks("COUNT 2022.xlsm")    ' "Copy-From" workbook
    On Error GoTo 0

    If WB1 Is Nothing Then
        MsgBox "Workbook :'" & " COUNT 2022.xlsm" & "' is not open", vbOKOnly Or vbExclamation, "Workbook not found"
        Exit Sub
    End If

    'Refresh Workbook
    WB1.RefreshAll

    'Open "Copy-To" workbook. Open method requires full file path to be referenced.
    FilePath = "\\serverpath\2022  2 Week Count.xlsx"    'specify workbook to be opened.

    'Make sure it is a valid file
    With CreateObject("Scripting.FileSystemObject")
        If Not .FileExists(FilePath) Then
            MsgBox "File not found:" & vbCr & FilePath, vbOKOnly Or vbExclamation, "File name Error"
            Exit Sub
        End If
    End With

    'Open workbook
    Set WB2 = Workbooks.Open(Filename:=FilePath)      ' "Copy-To" workbook

    'Copy sheet from "Copy-From" workbook to "Copy-To" workbook
    With WB1.Sheets("2018 1 Hour Counts")
        .Copy After:=WB2.Sheets(WB2.Sheets.Count)
        Set WS2 = WB2.Sheets(WB2.Sheets.Count)

        'Convert any formulas to values
         WS2.Range("A1:AC84").Value = .Range("A1:AC84").Value
    End With

    'Assign new sheet name
    TmpStr = WS2.Name
    Val = WB1.Worksheets("2018 1 Hour Counts").Range("AI1").Text

    For Each WS In WB2.Worksheets
        If WS.Name = Val Then
            Application.DisplayAlerts = False
            WS.Delete                                 'delete any existing sheet with the same name so that the rename operation will succeed.
            DelCnt = DelCnt + 1
            Application.DisplayAlerts = True
        End If
    Next WS

    'Test for validity
    On Error Resume Next
    WS2.Name = Val
    On Error GoTo 0

'begin debug
'MsgBox "Debug:" & vbCr & "   Val = '" & Val & "'" & vbCr & vbCr & _
'"   TmpStr = '" & TmpStr & "'" & vbCr & vbCr & _
'"   WS2.Name = '" & WS2.Name & "'" & vbCr & vbCr & _
'"   Parent = '" & WS2.Parent.Name _
', vbInformation, "Debug Message"
'end debug

    'If WS2.Name = TmpStr Then
        'Select Case MsgBox("Error - Sheet name '" & Val & _
                           '"' is invalid or already exists (" & DelCnt & ")" & vbCr & vbCr & _
                           '"Debug:" & vbCr & "   TmpStr = '" & TmpStr & "'" & vbCr & "   Val = '" & Val & "'" & vbCr & vbCr & _
                           '"Continue with file save operation?", vbYesNo + vbCritical, "Invalid File Name Error")
        'Case vbNo
            'WB2.Close SaveChanges:=False
            'Exit Sub
       ' End Select
    'End If

    'Save and close  "Copy-To" workbook
    WB2.Close SaveChanges:=True
End Sub

i had to comment out all the debug