Macro Mystery - Code suddenly stopped working?

[SuperFerret]

Hi all,

I have a macro which has been working for just over a year. Unfortunately as I've been seconded onto another project someone else has been amending the workbook and now the code doesn't work.

This is in Excel 2007 but we used to have to save it as a 2003-2007 compatible, but now we can save as xlsx or xlsm as required.

Sub Save_Me()
Dim ws As Worksheet, wb As Workbook
Application.DisplayAlerts = False
For Each ws In Sheets
    If ws.Name = "Item_Creation" Then
        Workbooks.Add
        Set wb = ActiveWorkbook
        With wb
            .SaveAs Filename:="S:\TRANS\Creates\" & Environ("username") & "\" & ws.Name & "_C" & ws.Range("A2").Value & "_" & Format(Date, "DD MMM") & FileExtStr = ".xlsm": FileFormatNum = 52
            ws.Copy Before:=.Sheets(1)
            .Sheets(1).Cells.Copy
            .Sheets(1).Cells.PasteSpecial xlValues
            .Save
            .Close
        End With
    End If
Next ws
Application.DisplayAlerts = True
End Sub

I get the error:
Run-time error '1004':
Excel cannot insert the sheets into the destination workbook, because it contains fewer rows and columns than the source workbook. To move or copy data to the destinations workbook, you can select the data, and then use the copy and paste commands to insert it into the sheets of another workbook.

Now I get why this is, but I need to be able to save this one worksheet (if I can save it as an xls then great) but I'm stuck. If someone could point me in the right direction I would be most appreciative

 

[circledchicken]

Hi,

Perhaps try making this amendment:

.Sheets(1)[COLOR=#a52a2a][B].Cells(1,1)[/B][/COLOR].PasteSpecial xlValues

 

[SuperFerret]

Hi CircledChicken, I tried that but I still get the same error I'm afraid

Bit more info: I have 6 worksheets in my workbook, the others being used for other imports into other systems and reporting etc. I require Sheet2 (Item_Creation) to be copied out and pasted as values then saved into the specified folder with the specified filename.

 

[circledchicken]

Oops sorry, I think I misread that.

Does this work for you or do you get the same error and on which line:

Sub Save_Me()

    Dim FileExtStr      As String
    Dim TempFilePath    As String
    Dim FileFormatNum   As Long
    Dim ws              As Worksheet
    Dim Sourcewb        As Workbook
    Dim Destwb          As Workbook
 
    FileExtStr = ".xlsm"
    FileFormatNum = 52
    TempFilePath = "S:\TRANS\Creates\" & _
                    Environ("username") & "\" & _
                    ws.Name & "_C" & _
                    ws.Range("A2").Value & "_" & _
                    Format(Date, "DD MMM") & FileExtStr
    Set ws = Sheets("Item_Creation")
        
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
 
        Set Sourcewb = ActiveWorkbook
     
        ' Copy the sheet to a new workbook
        ws.Copy
        Set Destwb = ActiveWorkbook
     
        ' Change all cells in the worksheet to values
        With Destwb.Sheets(1).UsedRange
            .Cells.Copy
            .Cells.PasteSpecial xlPasteValues
        End With
        Application.CutCopyMode = False
    
        ' Save the new workbook and close it
        With Destwb
            .SaveAs TempFilePath, FileFormat:=FileFormatNum
            .Close SaveChanges:=False
        End With
    
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With


End Sub

The code above is a shortened version of the complete code provided here which may be of interest to you:
Daily Dose of Excel » Blog Archive » SaveAs in Excel 2007

 

[SuperFerret]

Thanks CircledChicken. I've tried but I get another error now on this section:

TempFilePath = "S:\TRANS\Creates\" & _
                    Environ("username") & "\" & _
                    ws.Name & "_C" & _
                    ws.Range("A2").Value & "_" & _
                    Format(Date, "DD MMM") & FileExtStr

Saying: Run-time error '91': Object variable or with block variable not set

I did some digging around for alternative code myself but I couldn't get anything to work, thanks for all your help so far

 

[RoryA]

.SaveAs Filename:="S:\TRANS\Creates\" & Environ("username") & "\" & ws.Name & "_C" & ws.Range("A2").Value & "_" & Format(Date, "DD MMM") & FileExtStr = ".xlsm": FileFormatNum = 52

should perhaps be:

.SaveAs Filename:="S:\TRANS\Creates\" & Environ("username") & "\" & ws.Name & "_C" & ws.Range("A2").Value & "_" & Format(Date, "DD MMM") & ".xlsm", FileFormat:=52

 

[JackDanIce]

For post #5, the error is because at that point in the macro, ws doesn't appear to be set to a worksheet

 

[SuperFerret]

Thanks for the response Rory, but that just gives me the original run-time error

 

[SuperFerret]

Jack, mi old! How're you?

FileExtStr = ".xlsm"
    FileFormatNum = 52
    TempFilePath = "S:\TRANS\Creates\" & _
                    Environ("username") & "\" & _
                    ws.Name & "_C" & _
                    ws.Range("A2").Value & "_" & _
                    Format(Date, "DD MMM") & FileExtStr
    Set ws = Sheets("Item_Creation")

So in this would the 'set' have to be before this instead of after? I'm getting annoyed because someone has been messing with my code while I wasn't looking! I feel like the 3 bears when that blonde chick shows up

 

[RoryA]

Ah, you're going from xls to xlsx. Perhaps:

Sub Save_Me()
   Dim ws                     As Worksheet
   Dim wb                     As Workbook
   Application.DisplayAlerts = False
   For Each ws In Sheets
      If ws.Name = "Item_Creation" Then
         ws.Copy
         Set wb = ActiveWorkbook
         With wb
            With .Sheets(1).UsedRange
               .Value = .Value
            End With
            .SaveAs Filename:="S:\TRANS\Creates\" & Environ("username") & "\" & ws.Name & "_C" & ws.Range("A2").Value & "_" & Format(Date, "DD MMM") & ".xlsm", FileFormat:=52
            .Close
         End With
      End If
   Next ws
   Application.DisplayAlerts = True
End Sub