VBA split Multiple sheets After a particular sheet (Issue)-CodePudding

i had found fews lines of code online where

1: filter data from "Mst SKU" 2: split the data into different multiple sheets 3: sheet should be added before "All_total"

step 1 and 2 are working good but step 3 the sheets are added after last worksheet in workbook

added the screenshot ,sheet 1,2,3 is inserted after , which is dont want to happen it should be inserted before "All_Total" , please let me know where i am going wrong

Sub Splitdatabycol()


Dim Data_Sheet, allsku_Data_Sheet As Worksheet
Dim Pivot_Sheet As Worksheet
Dim StartPoint, DataRange As Range
Dim PivotName, NewRange, Asin, typ As String
Dim LastCol, lastRow, LastcolA, lastRowA, qtySum As Single
Dim priceSum As Single
Dim answer, j, k, l, Downcell, DowncellA, col1, col2, col3, col4, col5, col6, col7 As Integer
Dim saleExists, stockExists, errorExists, aListing As Boolean

Dim lr As Long
Dim ws As Worksheet
Dim vcol, i As Integer
Dim icol As Long
Dim myarr As Variant
Dim title As String
Dim titlerow As Integer
Dim xTRg As Range
Dim xVRg As Range
Dim xWSTRg As Worksheet
Dim xWS As Worksheet
Dim XwsNAme As Worksheet
Dim all_sku As Worksheet
On Error Resume Next
Set xTRg = Application.InputBox("Please select the header rows:", "Please Select Header", "'Mst SKU'!$AK$1", Type:=8)

If TypeName(xTRg) = "Nothing" Then Exit Sub
Set xVRg = Application.InputBox("Please select the column you want to split data based on:", "Please Select Column", "'Mst SKU'!$AK$1", Type:=8)

If TypeName(xVRg) = "Nothing" Then Exit Sub
vcol = xVRg.Column
Set ws = xTRg.Worksheet
lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
title = xTRg.AddressLocal
titlerow = xTRg.Cells(0).Row
icol = ws.Columns.Count
ws.Cells(0, icol) = "Unique"
Application.DisplayAlerts = False
If Not Evaluate("=ISREF('xTRgWs_Sheet!A1')") Then
'Sheets.Add(Before:=Worksheets(Worksheets.Count)).Name = "All Total"

Else
'Sheets("All Total").Delete
'Sheets.Add(Before:=Worksheets(Worksheets.Count)).Name = "xTRgWs_Sheet!A1"
'Sheets.Add(Before:=ActiveSheet).Name = "xTRgWs_Sheet!A1"
End If
Set xWSTRg = Sheets("xTRgWs_Sheet!A1")
xTRg.Copy
xWSTRg.Paste Destination:=xWSTRg.Range("A1")
ws.Activate
For i = (titlerow   xTRg.Rows.Count) To lr
On Error Resume Next
If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
End If
Next
myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
ws.Columns(icol).Clear
For i = 2 To UBound(myarr)
ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
Set xWS = Sheets.Add(Before:=Worksheets(Worksheets.Count))
xWS.Name = myarr(i) & ""
Else
'xWS.Move Before:=Worksheets(Worksheets.Count)
xWS.Move Before:=Worksheets(ActiveSheet)
End If
xWSTRg.Range(title).Copy
xWS.Paste Destination:=xWS.Range("A")
ws.Range("A" & (titlerow   xTRg.Rows.Count) & ":A" & lr).EntireRow.Copy xWS.Range("A" & (titlerow   xTRg.Rows.Count))
Sheets(myarr(i) & "").Columns.AutoFit
Next
xWSTRg.Delete
ws.AutoFilterMode = False
ws.Activate


        Application.DisplayAlerts = False
        Application.ScreenUpdating = False
        'Call split_data
        'Set Pivot Table & Source Worksheet
        Set Data_Sheet = ThisWorkbook.Worksheets("Mst SKU")
        Set Pivot_Sheet = ThisWorkbook.Worksheets("All Total")
        
        'Enter in Pivot Table Name
        PivotName = "PivotTable1"
        
        'Defining Staring Point & Dynamic Range
        Data_Sheet.Activate
        Set StartPoint = Data_Sheet.Range("A1")
        LastCol = StartPoint.End(xlToRight).Column
        Downcell = StartPoint.End(xlDown).Row
        Set DataRange = Data_Sheet.Range(StartPoint, Cells(Downcell, LastCol))
        NewRange = Data_Sheet.Name & "!" & DataRange.Address(ReferenceStyle:=xlR1C1)
        
        'Change Pivot Table Data Source Range Address
        Pivot_Sheet.PivotTables(PivotName). _
        ChangePivotCache ActiveWorkbook. _
        PivotCaches.Create(SourceType:=xlDatabase, SourceData:=NewRange)
        
        'Ensure Pivot Table is Refreshed
        Pivot_Sheet.PivotTables(PivotName).RefreshTable
        
        'Complete Message
        Pivot_Sheet.Activate
        MsgBox "Your Pivot Table is now updated."
        
        Dim TitleNAme As Range
        Application.ScreenUpdating = True
        Application.CutCopyMode = False
        Application.DisplayAlerts = True
        TitleNAme = Application.GetOpenFilename(Filefilter = "Excel Files,*.xlsx,*.xlsm")
        MsgBox TitleNAme

End Sub

CodePudding user response：

Following code will Add new Sheet before Last Sheet:

Sheets.Add(Before:=Sheets(Worksheets(Worksheets.Count).Name)).Name = "NewName"

CodePudding user response：

Like this:

Dim wb as Workbook, ws As Worksheet

Set wb = ActiveWorkbook 'or ThisWorkbook or some other open workbook
Set ws = wb.Worksheets.add(before:=wb.worksheets("All_Total"))