Need to Paste Formulas and Not Values in Current VBA Code

[NicoleAL123]

I have a pre-written VBA code that splits one worksheet out into multiple different worksheets based on the value in column B. It then saves each of the new files using the path in the tab "Settings". The only issue with the current code is that it only pastes the formula in column E to the first file created - all files created thereafter simply paste everything as values.

Is there a way to edit this code to ensure that the formulas carry through to all of the newly created files, and not just the first one? Sample excel file with the code is attached.

Thanks!

Here is the current code:

Option Explicit

Sub Split_Data_in_workbooks()

Application.ScreenUpdating = False

Dim data_sh As Worksheet
Set data_sh = ThisWorkbook.Sheets("Data")

Dim setting_Sh As Worksheet
Set setting_Sh = ThisWorkbook.Sheets("Settings")

Dim nwb As Workbook
Dim nsh As Worksheet

''''' Get unique supervisors

setting_Sh.Range("A:A").Clear
data_sh.AutoFilterMode = False
data_sh.Range("B:B").Copy setting_Sh.Range("A1")

setting_Sh.Range("A:A").RemoveDuplicates 1, xlYes

Dim i As Integer

For i = 2 To Application.CountA(setting_Sh.Range("A:A"))

data_sh.UsedRange.AutoFilter 2, setting_Sh.Range("A" & i).Value


Set nwb = Workbooks.Add
Set nsh = nwb.Sheets(1)

data_sh.UsedRange.SpecialCells(xlCellTypeVisible).Copy nsh.Range("A1")
nsh.UsedRange.EntireColumn.ColumnWidth = 15

nwb.SaveAs setting_Sh.Range("H6").Value & "/" & setting_Sh.Range("A" & i).Value & ".xlsx"
nwb.Close False
data_sh.AutoFilterMode = False
Next i

setting_Sh.Range("A:A").Clear

MsgBox "Done"

End Sub

[maras_mak]

hi, Try the corrected code

Sub Split_Data_in_workbooks()

    Application.ScreenUpdating = False
    
    Dim data_sh As Worksheet
    Set data_sh = ThisWorkbook.Sheets("Data")
    
    Dim setting_Sh As Worksheet
    Set setting_Sh = ThisWorkbook.Sheets("Settings")
    
    Dim nwb As Workbook
    Dim nsh As Worksheet
    
    ''''' Get unique supervisors
    
    setting_Sh.Range("A:A").Clear
    data_sh.Range("B:B").Copy setting_Sh.Range("A1")
    
    setting_Sh.Range("A:A").RemoveDuplicates 1, xlYes
    
    Dim i As Integer
    
    For i = 1 To Application.CountA(setting_Sh.Range("A:A"))
    
        Set nwb = Workbooks.Add
        ActiveSheet.Name = setting_Sh.Range("A:A").Cells(i)
        
        Set nsh = ActiveSheet
        data_sh.UsedRange.SpecialCells(xlCellTypeVisible).Copy nsh.Range("A1")
        nsh.UsedRange.EntireColumn.ColumnWidth = 15
        
        nwb.SaveAs setting_Sh.Range("H6").Value & "/" & nsh.Name & ".xlsx"
        nwb.Close False
    Next i
    setting_Sh.Range("A:A").Clear
    
    MsgBox "Done"
End Sub

Regards.

[NicoleAL123]

Hmm it is keeping the formulas in column E but no longer splitting the documents out by the value in column B.

[jindon]

Try

Sub Split_Data_in_workbooksx()
    Dim data_sh As Worksheet, setting_Sh As Worksheet, i As Integer
    Application.ScreenUpdating = False
    Set data_sh = ThisWorkbook.Sheets("Data")
    
    Set setting_Sh = ThisWorkbook.Sheets("Settings")

    ''''' Get unique supervisors
    
    setting_Sh.Range("A:A").Clear
    data_sh.AutoFilterMode = False
    data_sh.Range("B:B").Copy setting_Sh.Range("A1")
    
    setting_Sh.Range("A:A").RemoveDuplicates 1, xlYes
    
    Sheets.Add Sheets(1)
    With Sheets(1)
        For i = 2 To Application.CountA(setting_Sh.Range("A:A"))
            data_sh.Cells(1).CurrentRegion.Copy .Cells(1)
            With .Cells(1).CurrentRegion
                .AutoFilter 2, "<>" & setting_Sh.Range("A" & i).Value
                .Offset(1).EntireRow.Delete
                .AutoFilter
                .Columns.ColumnWidth = 15
            End With
            .Copy
            With ActiveWorkbook
                .Sheets(1).Name = setting_Sh.Range("A" & i).Value
                .SaveAs setting_Sh.Range("H6").Value & "/" & setting_Sh.Range("A" & i).Value & ".xlsx"
                .Close False
            End With
        Next
        Application.DisplayAlerts = False
        .Delete
        Application.ScreenUpdating = True
    End With
    setting_Sh.Range("A:A").Clear
    MsgBox "Done"
End Sub

[NicoleAL123]

This works perfectly, thank you!