Macros editing

jimmi_10 - Oct 31, 2015 at 04:28 AM
rizvisa1 Posts 4479 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 - Nov 3, 2015 at 12:24 PM
Hi Guys,

I have created a macro that splits a master worksheet into separate tabs based on specific criteria then saves each tab as a separate workbook to a folder.

When I save the macro in the workbook it seems to all work fine, however when I save it to my personal.xls it does't seem to save the sheets from my workbook to the folder. It saves the one blank sheet from my personal.xls.

This is my code:

Sub parse_data()
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
vcol = 32
Set ws = Sheets("Sheet1")
lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
title = "A1:AN1"
titlerow = ws.Range(title).Cells(1).Row
icol = ws.Columns.Count
ws.Cells(1, icol) = "Unique"
For i = 2 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
myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
For i = 2 To UBound(myarr)
ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
End If
ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
Sheets(myarr(i) & "").Columns.AutoFit
ws.AutoFilterMode = False
MyPath = ThisWorkbook.Path
For Each sht In ThisWorkbook.Sheets
ActiveSheet.Cells.PasteSpecial Paste:=xlPasteValues
ActiveSheet.Cells.PasteSpecial Paste:=xlPasteFormats
ActiveWorkbook.SaveAs Filename:="C:\Users\jamie\Google Drive\My Documents\Excel Test\" & sht.Name & " 2015 Zone Challenge Nominations" & ".xls"
ActiveWorkbook.Close savechanges:=False
Next sht
End Sub

It seems to be something to do with the section after Mypath = this Workbook.Path.

Does someone know how to fix this?

1 reply

rizvisa1 Posts 4479 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 768
Nov 3, 2015 at 12:24 PM
I think the issue is this
For Each sht In ThisWorkbook.Sheets

You may to try with activeworkbook.sheets