VBA to Copy and Paste data into New Workbook, then find and replace cell references

[OllieT81]

Hi all,

I am working to export a data set from one workbook, with the new workbook being macro-free. I then need to replace the formula references in the new Workbook to remove the old workbook. I have cobbled together coding from various sources, but cannot get the replace part of the coding to work.

Any help is super appreciated.

Public Sub ExportNewBook()

    Dim newWb As Workbook
    sname = ActiveWorkbook.Worksheets("Summary").Range("B1") & ".xlsx"
    Dim newWbPath As String: newWbPath = ThisWorkbook.Path & "\" & sname
    Dim FindMe As String, Replacement As String
    FindMe = "[2025_ONA_Monthly_Schedule_randomizer - Test 2.xlsm]"
    Replacement = ""
    
     Application.SheetsInNewWorkbook = 8
    Set newWb = Workbooks.Add
    
    ThisWorkbook.Worksheets("Summary").Cells.Copy
    newWb.Worksheets(1).Cells.PasteSpecial Paste:=xlPasteFormulas
    newWb.Worksheets(1).Cells.PasteSpecial Paste:=xlPasteFormats
    Application.CutCopyMode = False
    newWb.Worksheets("Sheet1").Name = "Summary"
    
        ThisWorkbook.Worksheets("Adult Assignment").Cells.Copy
    newWb.Worksheets(2).Cells.PasteSpecial Paste:=xlPasteValues
    newWb.Worksheets(2).Cells.PasteSpecial Paste:=xlPasteFormats
    Application.CutCopyMode = False
    newWb.Worksheets("Sheet2").Name = "Adult Assignment"
    
        ThisWorkbook.Worksheets("Youth Assignment").Cells.Copy
    newWb.Worksheets(3).Cells.PasteSpecial Paste:=xlPasteValues
    newWb.Worksheets(3).Cells.PasteSpecial Paste:=xlPasteFormats
    Application.CutCopyMode = False
    newWb.Worksheets("Sheet3").Name = "Youth Assignment"
    
        ThisWorkbook.Worksheets("SCONAs").Cells.Copy
    newWb.Worksheets(4).Cells.PasteSpecial Paste:=xlPasteValues
    newWb.Worksheets(4).Cells.PasteSpecial Paste:=xlPasteFormats
    Application.CutCopyMode = False
    newWb.Worksheets("Sheet4").Name = "SCONAs"
    
        ThisWorkbook.Worksheets("SCONAY").Cells.Copy
    newWb.Worksheets(5).Cells.PasteSpecial Paste:=xlPasteValues
    newWb.Worksheets(5).Cells.PasteSpecial Paste:=xlPasteFormats
    Application.CutCopyMode = False
    newWb.Worksheets("Sheet5").Name = "SCONAY"
    
            ThisWorkbook.Worksheets("BA ONAs").Cells.Copy
    newWb.Worksheets(6).Cells.PasteSpecial Paste:=xlPasteValues
    newWb.Worksheets(6).Cells.PasteSpecial Paste:=xlPasteFormats
    Application.CutCopyMode = False
    newWb.Worksheets("Sheet6").Name = "BA ONAs"
    
            ThisWorkbook.Worksheets("BY ONAS").Cells.Copy
    newWb.Worksheets(7).Cells.PasteSpecial Paste:=xlPasteValues
    newWb.Worksheets(7).Cells.PasteSpecial Paste:=xlPasteFormats
    Application.CutCopyMode = False
    newWb.Worksheets("Sheet7").Name = "BY ONAS"
    
            ThisWorkbook.Worksheets("CIIS").Cells.Copy
    newWb.Worksheets(8).Cells.PasteSpecial Paste:=xlPasteValues
    newWb.Worksheets(8).Cells.PasteSpecial Paste:=xlPasteFormats
    Application.CutCopyMode = False
    newWb.Worksheets("Sheet8").Name = "CIIS"
    
     'This is where this issue is at - can't get this part to work  
    newWb.Sheets("Summary").Activate
    Columns("B:w").Replace FindMe, Replacement, xlWhole, , True, , False, False
    
    newWb.SaveAs newWbPath
    
End Sub

 

[DanteAmor]

Hi and welcome to MrExcel

Dim FindMe As String, Replacement As String

It is not recommended to use reserved words as variables, it may cause errors or unexpected results. In this case Replacement, is the name of one of the parameters of the Replace function.

I changed that variable to another name and also changed the xlWhole parameter to xlPart, since you are going to search partially within the cell content. xlWhole is used to search for the entire contents of the cell.

I made other adjustments to your macro, if you have any questions about any line in the macro, you can ask me.

Try and comment:

Public Sub ExportNewBook()
  Dim newWb As Workbook
  Dim sName As String, newWbPath As String, FindMe As String, ReplMe As String
  Dim NameSheets As Variant
  Dim i As Long
 
  Application.SheetsInNewWorkbook = 8
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
 
  sName = ActiveWorkbook.Sheets("Summary").Range("B1") & ".xlsx"
  newWbPath = ThisWorkbook.Path & "\" & sName
  FindMe = "[2025_ONA_Monthly_Schedule_randomizer - Test 2.xlsm]"
  ReplMe = ""
  NameSheets = Array("", "Summary", "Adult Assignment", "Youth Assignment", "SCONAs", _
                         "SCONAY", "BA ONAs", "BY ONAS", "CIIS")
  Set newWb = Workbooks.Add
 
  For i = 1 To UBound(NameSheets)
    ThisWorkbook.Sheets(NameSheets(i)).Cells.Copy
    With newWb.Sheets(i)
      .Cells.PasteSpecial Paste:=xlPasteFormulas
      .Cells.PasteSpecial Paste:=xlPasteFormats
      .Name = NameSheets(i)
    End With
  Next
 
  newWb.SaveAs newWbPath
  newWb.Sheets("Summary").Activate
  Range("B:W").Replace FindMe, ReplMe, xlPart, , True, , False, False
 
  Application.CutCopyMode = False
  Application.SheetsInNewWorkbook = 1
End Sub

 

[OllieT81]

Thank you so much for the help. That did the trick!