Copy, Paste Value, Save Worksheet - Multiple Worksheets-CodePudding

I have a workbook with many worksheets. I am attempting to use the below macro to cycle the worksheets, copy and paste value, then save off individually in a location.

I feel like I'm glossing over something very small and beginning to go bonkers. Currently this code copies and pastes value the first worksheet, and then saves the rest off without the copy/paste. So everything is working as desired with the exception of the copy/paste value not occurring with each worksheet.

Sub SaveFilesInFolder()
'
'This is for saving each worksheet as a workbook in a destination folder as an excel file
'

'
    Dim sh As Worksheet
    Dim wb As Workbook
    
    For Each sh In Worksheets
    
        With ActiveWorkbook
        Cells.Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
               
        SheetName = sh.Name
        sh.Copy
    
            .SaveAs Filename:="C:\Location\" & SheetName
            .Close SaveChanges:=True
        End With
    
    Next sh
 
End Sub

Any and all assistance is greatly appreciated.

Edit:

Below is the updated code from comments. Unfortunately, the sheet is still copying/pasting for the first worksheet and not the rest. Everything is saving in the specified location as intended.

Sub SaveFilesInFolder()
'
'This is for saving each worksheet as a workbook in a destination folder as an excel file
'

'
    Dim sh As Worksheet
    Dim wb As Workbook
    Dim rng As Range
    
    For Each sh In ThisWorkbook.Worksheets
    
        Set rng = Cells
    
        rng.Copy
        rng.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
               
        sh.Copy
        ActiveWorkbook.SaveAs ("C:\Location\" & sh.Name)
        ActiveWorkbook.Close
    
    Next sh
 
End Sub

CodePudding user response：

Try it without the clipboard. I've also turned off alerts (for saving over files) and done a small amount of clean up.

Sub SaveFilesInFolder()
'
'This is for saving each worksheet as a workbook in a destination folder as an excel file
'

'
    On Error GoTo e

    Application.DisplayAlerts = False
    Dim sh As Worksheet
    For Each sh In ThisWorkbook.Worksheets
    
        With sh.UsedRange
            .Value2 = .Value2
        End With
        
        sh.Copy
        ActiveWorkbook.Close True, "C:\Location\" & sh.Name
    Next sh
e:
'   Ensure alerts are turned back on before re-throwing.
    Application.DisplayAlerts = True
    If Err > 0 Then Err.Raise Err
End Sub

CodePudding user response：

Export Worksheets

To leave the source workbook intact, convert formulas to values in the destination workbooks.

Sub ExportWorksheets()

    Const dFolderPath As String = "C:\Location\"

    Dim swb As Workbook: Set swb = ThisWorkbook

    Dim dPath As String: dPath = dFolderPath
    If Right(dPath, 1) <> Application.PathSeparator Then
        dPath = dPath & Application.PathSeparator
    End If

    Application.ScreenUpdating = False
    
    Dim sws As Worksheet
    Dim dwb As Workbook
    Dim dws As Worksheet
    Dim drg As Range

    For Each sws In swb.Worksheets

        sws.Copy ' copied to a new single-worksheet workbook

        Set dwb = Workbooks(Workbooks.Count) ' the last
        Set dws = dwb.Worksheets(1) ' the one and only
        Set drg = dws.UsedRange

        drg.Value = drg.Value ' formulas to values

        Application.DisplayAlerts = False ' to overwrite without confirmation
            dwb.SaveAs dPath & dws.Name
        Application.DisplayAlerts = True

        dwb.Close SaveChanges:=False ' it's already been saved

    Next sws

    Application.ScreenUpdating = True

    MsgBox "Worksheets exported to single-worksheet workbooks.", vbInformation

End Sub