Splitting and Hardcoding worksheets containing pivot tables - vba

Question

I am new to using VBA code. I have a workbook with manually created tables as well as pivot tables. For each worksheet in this book, I want to hard-code the data into a new workbook and save it as the name of the worksheet that is being hard-coded. I have the code below. It is saving each workbook properly, but the contents of the workbook are not correct. It is hard-coding the contents of the first worksheet in my original workbook every time. I've tried to set the next ActiveSheet at the end of the code but it fails. Did I mention I am not a programmer? Please help!
Sub Splitbook()
Dim path As String
Dim dt As String
path = CreateObject("WScript.Shell").specialfolders("Desktop") & "\SLF\ "
Call Shell("explorer.exe" & " " & path, vbNormalFocus)
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
ActiveSheet.UsedRange.Select
Selection.Copy
Workbooks.Add
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveWorkbook.SaveAs path & ws.Name, Excel.XlFileFormat.xlOpenXMLWorkbook
ActiveWorkbook.Close SaveChanges:=False
Next ws
End Sub

Answer 1

You already have the code looping through the sheets of your workbook so you do not need to copy from the ActiveSheet but from the ws worksheet variable.
You also do not need to use Select to get data copied.
Dim ws As Worksheet
Dim newBook As Workbook
For Each ws In ThisWorkbook.Worksheets
ws.UsedRange.Copy
Set newBook = Workbooks.Add
With newBook.Worksheets(1).Range("A1")
.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End With
newBook.SaveAs Path & ws.Name, Excel.XlFileFormat.xlOpenXMLWorkbook
newBook.Close SaveChanges:=False
Next ws