With the help of others, I was able to build this working code. I do however need help in adding conditions to it.
Before the worksheets are moved to a new file it must first check if a file of the same name already exist. If one does exist, then it should just update it (paste new data at the bottom). If none exist, then it should create one (which is what this code is doing)
Sub ExportSheets()
' Export segregated sheets to individual workbooks
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim sPath As String, sAddress As String, wsCur As Worksheet
Dim arrNoMoveSh, mtchSh
Dim sht As String
Dim x As Range
Dim rng As Range
Dim last As Long
Dim ControllerTab As Worksheet
Dim ControllerTabBase As Range
Set ControllerTab = ThisWorkbook.Worksheets("Controller")
Set ControllerTabBase = ControllerTab.Range("B1")
' --Creates an array of the sheet names to not be moved
arrNoMoveSh = Split("Read Me,Validations,Controller,MTI Data,Other", ",")
' --Store path of this workbook
sPath = ThisWorkbook.path & Application.PathSeparator
' --Loop through worksheets
For Each wsCur In ThisWorkbook.Worksheets
mtchSh = Application.Match(wsCur.Name, arrNoMoveSh, 0)
If IsError(mtchSh) Then 'no sheet names found in the array
wsCur.Copy 'create a new workbook for the sheet to be copied!!!
' --Specifies the sheet name in which the data is stored
sht = wsCur.Name
last = Sheets(sht).Cells(Rows.Count, "A").End(xlUp).Row
Set rng = Sheets(sht).Range("A1:P" & last)
Sheets(sht).Range("N1:N" & last).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("BB1"), Unique:=True
For Each x In Range([BB2], Cells(Rows.Count, "BB").End(xlUp))
With rng
.AutoFilter Field:=14, Criteria1:=x.Value
.SpecialCells(xlCellTypeVisible).Copy
Sheets.Add(After:=Sheets(Sheets.Count)).Name = x.Value
ActiveSheet.Paste
End With
Next x
Sheets(sht).Activate
Sheets(sht).Delete
ActiveWorkbook.SaveAs sPath & wsCur.Name & ".xlsx"
ActiveWorkbook.Close SaveChanges:=True
End If
Next wsCur
Application.ScreenUpdating = True
Application.DisplayAlerts = True
ControllerTab.Activate
ControllerTabBase.Select
End Sub
CodePudding user response:
Here's a function to determine whether a file currently exists:
Private Function FileExists(FileName As String) As Boolean
On Error Resume Next
FileExists = CBool(FileLen(FileName) 1)
End Function
CodePudding user response:
Function FileExists(FileName As String) As Boolean
FileExists = Len(Dir(FileName)) > 0
End Function
Usage
I would add the FileExists(FileName)
clase to the existing If
statement.
FileName = sPath & wsCur.Name & ".xlsx"
If IsError(mtchSh) And Not FileExists(FileName) Then 'no sheet names found in the array