Sheet1表達肯定錯誤，我看不到你的表，猜測要麼Sheets(1),或者Sheets("1")，很有可能Sheets("Sheet1")才對。

"從字面來分析: bg.Name = Sheet1.Cells(i, l)

"其完整寫法如下: bg.Name = Sheet1.Cells(i, l).Value

"意思是：工作表bg的名稱和Sheet1.Cells(i,l)裡儲存的值相同

"結合你前面的程式碼:

"下面For each bg In Sheets，這一行實際就沒意義了，因為Sheets裡總共就只有一個成員。

"沒有文件，嘗試猜測一下你的意思：

"1、L記錄使用者輸入的列號，從下文看，L是列號，並不是行

"4、開啟提示，這裡應該是True

"5、然後重新根據"Sheet1"的（2-最後行L列）的內容新建一系列工作表

"6、然後從Sheet1中篩選資料，並逐個儲存到新建的一系列工作表中去

"以下我先抱個歉:

"1.程式碼可讀性實在是太差了

"2.邏輯上不清楚的地方比較多

"我稍微理一下，僅供參考：

Sub SheetSplit()

Application.ScreenUpdating = False "關閉螢幕重新整理，提高執行效率

Dim i&, j&, aRow&

Dim bk As Workbook

Dim sht As Worksheet

Dim shtNew As Worksheet

Set bk = ThisWorkbook

j = InputBox("以哪一列為基準？")

Application.DisplayAlerts = False

For Each sht In bk.Worksheets

If sht.Name <> "Sheet1" Then sht.Delete

Next sht

Application.DisplayAlerts = True

"重建工作表

Set sht = bk.Worksheets("Sheet1")

aRow = sht.Range("A" & sht.Rows.Count).End(xlUp).Row

For i = 2 To aRow

If False = SheetExist(bk, sht.Cells(i, L)) Then

Set shtName = bk.Worksheets.Add(After:=bk.Worksheets(bk.Worksheets.Count))

shtNew.Name = sht.Cells(i, j).Value

"實際可以這麼簡寫，但是新手沒有判斷能力，不推薦

"bk.Worksheets.Add(After:=bk.Worksheets(bk.Worksheets.Count)).Name = sht.Cells(i, j).Value

End If

Next i

"拆分資料

For i = 2 To bk.Worksheets.Count

"這裡實在猜不下去了，又來了一個"A1:D1943"列，Field:=4，實在猜不透想作甚

"算了，繼續猜，假設是對使用者輸入的"L"列做篩選

Set shtNew = bk.Worksheets(i)

sht.Range(sht.Cells(1, 1), sht.Cells(1943, L)).AutoFilter Field:=L, Criterial:=shtNew.Name

sht.Range("A1:" & L & aRow).Copy shtNew.Range("A1") "這兩行程式碼未驗證，直接抄的你的

Next i

Application.ScreenUpdating = True

End Sub

Function SheetExist(bk As Workbook, ByVal shtName As String) As Boolean

Err.Clear

On Error Resume Next

Dim shtTemp As Worksheet

Set shtTemp = bk.Worksheets(shtName)

SheetExist = (Err.Number = 0)

End Function