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

 

[rlv01]

if i hit debug it takes me to the line

ActiveSheet.Name = Val

There is no such line in your Sub Copy. Can you please clarify or add it in then re-post your code? It is hard to address a problem with a line of code if you do not include that line when you post your code.

 

[agentkramr]

There is no such line in your Sub Copy. Can you please clarify or add it in then re-post your code? It is hard to address a problem with a line of code if you do not include that line when you post your code.

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
ActiveSheet.Name = Val
'Columns("AF:AI").Delete

ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub


apologies

 

[rlv01]

See if this works. It has enough error checking that if it does not, it should provide a clue as to why not.

Sub Copy()
    Dim WB1 As Workbook, WB2 As Workbook
    Dim WS2 As Worksheet
    Dim Val As String, TmpStr As String, FilePath As String

    '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 = "\\filepapth\TEST\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
    WB1.Sheets("New").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

    'Assign new sheet name
    TmpStr = WS2.Name
    Val = WS2.Range("AI1").Value
    
    'Test for validity
    On Error Resume Next
    WS2.Name = Val
    On Error GoTo 0

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

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

 

[agentkramr]

See if this works. It has enough error checking that if it does not, it should provide a clue as to why not.

Sub Copy()
    Dim WB1 As Workbook, WB2 As Workbook
    Dim WS2 As Worksheet
    Dim Val As String, TmpStr As String, FilePath As String

    '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 = "\\filepapth\TEST\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
    WB1.Sheets("New").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

    'Assign new sheet name
    TmpStr = WS2.Name
    Val = WS2.Range("AI1").Value
   
    'Test for validity
    On Error Resume Next
    WS2.Name = Val
    On Error GoTo 0

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

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

here is what i am getting with that i just want it to add that sheet to the workbook that already exists and is named, it will name the sheet the cell contents which the contents is todays date, there isnt a tab already in there with todays date and the date format is month day so Aug 30

 

[rlv01]

it will name the sheet the cell contents which the contents is todays date

That may be what you want it to do, but that is not what is happening. The error message indicates there is nothing in the cell where you are expecting the date to be. This bit of code checks the validity of the sheet name.

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

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

It tries to rename the sheet with the string (Dim Val As String) contained in the variable Val, which per your definition comes from cell AI1 ( Val = WS2.Range("AI1").Value). But if the the string in Val is invalid/illegal, then the renaming attempt fails and an error message is produced. That's what is happening. The message box indicates Val = "" which is not a legal file name.

You must figure out why you are not getting a good file name from Cell AI1. You could add this debug code to see if the sheet is the one you expect

    TmpStr = WS2.Name
    Debug.Print WS2.Range("AI1").Address(, , , True)  '<- add for debug use
    Val = WS2.Range("AI1").Value

, or try setting some breakpoints and inspect the values of the variables during execution.

Minor typo correction. This

    ", is invalid or already exists" & vbCr & vbCr & _

should be this

  "' is invalid or already exists" & vbCr & vbCr & _

(comma changes to single quote mark, does not affect validity of error message)

 

[agentkramr]

That may be what you want it to do, but that is not what is happening. The error message indicates there is nothing in the cell where you are expecting the date to be. This bit of code checks the validity of the sheet name.

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

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

It tries to rename the sheet with the string (Dim Val As String) contained in the variable Val, which per your definition comes from cell AI1 ( Val = WS2.Range("AI1").Value). But if the the string in Val is invalid/illegal, then the renaming attempt fails and an error message is produced. That's what is happening. The message box indicates Val = "" which is not a legal file name.

You must figure out why you are not getting a good file name from Cell AI1. You could add this debug code to see if the sheet is the one you expect

    TmpStr = WS2.Name
    Debug.Print WS2.Range("AI1").Address(, , , True)  '<- add for debug use
    Val = WS2.Range("AI1").Value

, or try setting some breakpoints and inspect the values of the variables during execution.

Minor typo correction. This

    ", is invalid or already exists" & vbCr & vbCr & _

should be this

  "' is invalid or already exists" & vbCr & vbCr & _

(comma changes to single quote mark, does not affect validity of error message)

added the snips of code, the error has changed slightly to the first image the second image shows what the contents are in AI1

 

[rlv01]

added the snips of code, the error has changed slightly to the first image the second image shows what the contents are in AI1

Did you try my debugging suggestions? What were the results?

 

[agentkramr]

Did you try my debugging suggestions? What were the results?

i added the breakpooint put maybe im not doing it right ....
i still got the same exact error in the screenshot above

 

[rlv01]

Sub Copy()
    Dim WB1 As Workbook, WB2 As Workbook
    Dim WS2 As Worksheet
    Dim Val As String, TmpStr As String, FilePath As String

    '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 = "\\filepapth\TEST\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
    WB1.Sheets("New").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

    'debug
    Dim S As String, R As Range
    S = "WB1 = " & WB1.Name & vbCr
    S = S & "WB2 = " & WB2.Name & vbCr & vbCr
    With WB1.Worksheets("New").Range("AI1")
        S = S & .Address(0, 0, , 1) & " = " & .Text & vbCr
    End With
    With WS2.Range("AI1")
        S = S & .Address(0, 0, , 1) & " = " & .Text & vbCr & vbCr
    End With
    Val = WS2.Range("AI1").Text
     S = S & "Val = " & Val
    MsgBox S
    ' end debug

    'Assign new sheet name
    TmpStr = WS2.Name
    Val = WS2.Range("AI1").Text

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

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

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