update/adapt code already on forum

[rjmdc]

i will start my own thread rather than "hog" another thread
mr danteamor already created this macro to create workbooks
it will not overwrite an existing workbook. it will only create new ones
i need to adapt this code that every time its run, it searches for the workbook, if found it will update, if not found it will create
is that possible?

Sub SplitIntoBooks()
  Dim wb As Workbook, c As Range, ky As Variant
  Dim lr As Long, lc As Long
  
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  
  Sheet1.Range("A1").AutoFilter
  lr = Sheet1.Range("F" & Rows.Count).End(3).Row
  lc = Sheet1.Cells(1, Columns.Count).End(1).Column
  With CreateObject("scripting.dictionary")
    For Each c In Sheet1.Range("F2:F" & lr)
      .Item(c.Value) = Empty
    Next
    For Each ky In .Keys
      Sheet1.Range("A1", Sheet1.Cells(lr, lc)).AutoFilter 6, ky
      Set wb = Workbooks.Add(xlWBATWorksheet)
      Sheet1.AutoFilter.Range.Copy
      Range("A1").PasteSpecial xlPasteAll
      wb.SaveAs ThisWorkbook.Path & "\" & ky
      wb.Close False
    Next
  End With
  
  Sheet1.ShowAllData
  Application.ScreenUpdating = True
End Sub

 

[DanteAmor]

if found it will update

How to update?
Overwrite all data?
Paste the data after the last data?

Try this:

Sub SplitIntoBooks()
  Dim wb As Workbook, c As Range, ky As Variant
  Dim lr As Long, lc As Long
  Dim sName As String
  
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  
  Sheet1.Range("A1").AutoFilter
  lr = Sheet1.Range("F" & Rows.Count).End(3).Row
  lc = Sheet1.Cells(1, Columns.Count).End(1).Column
  With CreateObject("scripting.dictionary")
    For Each c In Sheet1.Range("F2:F" & lr)
      .Item(c.Value) = Empty
    Next
    For Each ky In .Keys
      Sheet1.Range("A1", Sheet1.Cells(lr, lc)).AutoFilter 6, ky
      sName = ThisWorkbook.Path & "\" & ky & ".xlsx"
      If Dir(sName) = "" Then
        Set wb = Workbooks.Add(xlWBATWorksheet)
      Else
        Set wb = Workbooks.Open(sName)
      End If
      Sheet1.AutoFilter.Range.Copy
      Range("A" & Rows.Count).End(3)(2).PasteSpecial xlPasteAll
      wb.SaveAs ThisWorkbook.Path & "\" & ky
      wb.Close False
    Next
  End With
  
  Sheet1.ShowAllData
  Application.ScreenUpdating = True
End Sub

 

[rjmdc]

IN REPLY:
How to update?
Overwrite all data? YES
Paste the data after the last data? overwrite

 

[rjmdc]

this seems to have worked amazingly
thanks

 

[rjmdc]

how would i label sheet 1 as "All Payments" instead of workbook name which is the split name?

 

[rjmdc]

how can i use your code with this one that i am replacing that i also adapted form the forum

Sub Splitbook()

Dim xPath As String
xPath = "M:\all\FI Payments\Single Participant Payment Worksheets\split file 3\"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each xWs In ThisWorkbook.Sheets
   Select Case xWs.Name
      Case "All Payments"
      Case Else
    xWs.Copy
         Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & xWs.Name & ".xlsx"
         Application.ActiveWorkbook.Close False
   End Select
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True

MsgBox "Complete"
End Sub

 

[DanteAmor]

this seems to have worked amazingly

I'm glad to help you. Thanks for the feedback.

That last one is a new code, so you should create a new thread, there you explain your requirements.