Note: The other languages of the website are Google-translated. Back to English

如何在Excel中為每一行創建新工作表?

假設您在 A 列中有一個包含所有學生姓名的分數表。現在您要根據 A 列中的這些姓名創建新工作表,並使每張工作表包含唯一的學生數據。 或者只為表中的每一行創建新工作表,而不考慮 A 列中的名稱。在本視頻中,您將獲得實現它的方法。

使用VBA代碼為每一行創建新的工作表
使用Kutools for Excel的Split Data實用程序為每一行創建新工作表


使用VBA代碼為每一行創建新的工作表

使用以下代碼,您可以基於列值創建新的工作表,或者只為Excel中的每一行創建新的工作表。

1。 按 其他 + F11 同時打開 Microsoft Visual Basic for Applications 窗口。

2。 在裡面 Microsoft Visual Basic for Applications 窗口中,單擊 插入 > 模塊。 然後將以下代碼粘貼到 模塊 窗口。

VBA代碼:基於列為每一行創建新的工作表

Sub parse_data()
'Update by Extendoffice 2018/3/2
    Dim xRCount As Long
    Dim xSht As Worksheet
    Dim xNSht As Worksheet
    Dim I As Long
    Dim xTRrow As Integer
    Dim xCol As New Collection
    Dim xTitle As String
    Dim xSUpdate As Boolean
    Set xSht = ActiveSheet
    On Error Resume Next
    xRCount = xSht.Cells(xSht.Rows.Count, 1).End(xlUp).Row
    xTitle = "A1:C1"
    xTRrow = xSht.Range(xTitle).Cells(1).Row
    For I = 2 To xRCount
        Call xCol.Add(xSht.Cells(I, 1).Text, xSht.Cells(I, 1).Text)
    Next
    xSUpdate = Application.ScreenUpdating
    Application.ScreenUpdating = False
    For I = 1 To xCol.Count
        Call xSht.Range(xTitle).AutoFilter(1, CStr(xCol.Item(I)))
        Set xNSht = Nothing
        Set xNSht = Worksheets(CStr(xCol.Item(I)))
        If xNSht Is Nothing Then
            Set xNSht = Worksheets.Add(, Sheets(Sheets.Count))
            xNSht.Name = CStr(xCol.Item(I))
        Else
            xNSht.Move , Sheets(Sheets.Count)
        End If
        xSht.Range("A" & xTRrow & ":A" & xRCount).EntireRow.Copy xNSht.Range("A1")
        xNSht.Columns.AutoFit
    Next
    xSht.AutoFilterMode = False
    xSht.Activate
    Application.ScreenUpdating = xSUpdate
End Sub

備註:A1:C1是表的標題範圍。 您可以根據需要進行更改。

3。 按 F5 鍵來運行代碼,然後在當前工作簿的所有工作表之後創建新的工作表,如下圖所示:

如果要直接為每行創建新的工作表而不考慮列值,則可以使用以下代碼。

VBA代碼:直接為每一行創建新工作表

Sub RowToSheet()
	Dim xRow As Long
	Dim I As Long
	With ActiveSheet
		xRow = .Range("A" & Rows.Count).End(xlUp).Row
		For I = 1 To xRow
			Worksheets.Add(, Sheets(Sheets.Count)).Name = "Row " & I
			.Rows(I).Copy Sheets("Row " & I).Range("A1")
		Next I
	End With
End Sub

運行代碼後,活動工作表中的每一行都將放置在新工作表中。

備註:標題行也將與此VBA代碼一起放在新工作表中。


使用Kutools for Excel的Split Data實用程序為每一行創建新工作表

實際上,上述方法是複雜且難以理解的。 在本節中,我們向您介紹 拆分數據 的效用 Excel的Kutools.

申請前 Excel的Kutools首先下載並安裝.

1.選擇您需要用於創建新表的表,然後單擊 Kutools 加> 吐出數據。 看截圖:

2。 在裡面 將數據拆分為多個工作表 對話框,請執行以下操作。

A.基於列值創建新表:

1)。 請選擇 特定欄 選項,然後在下拉列表中指定要用於拆分數據的列;
2)。 如果要使用列值命名工作表,請選擇 列的值規則 下拉列表;
3)。 點擊 OK 按鈕。 看截圖:

B.為每行直接創建新的工作表:

1)。 選擇 固定行 選項,輸入數字 1 放進盒子裡
2)。 選擇 行號 來自 規則 下拉列表;
3)。 點擊 OK 按鈕。 看截圖:

將創建一個新工作簿,其中包含所有新工作表。 請參見下面的屏幕截圖。

根據列值為每一行創建新的工作表:

在不考慮列值的情況下為每一行創建新的工作表:

  如果您想免費試用(30-day) 這個實用程序, 請點擊下載,然後按照上述步驟進行操作。

使用Kutools for Excel的Split Data實用程序為每一行創建新工作表


最佳辦公效率工具

Kutools for Excel 解決了你的大部分問題,並將你的生產力提高了 80%

  • 重用: 快速插入 複雜的公式,圖表 以及您以前使用過的任何東西; 加密單元 帶密碼 創建郵件列表 並發送電子郵件...
  • 超級公式欄 (輕鬆編輯多行文本和公式); 閱讀版式 (輕鬆讀取和編輯大量單元格); 粘貼到過濾範圍...
  • 合併單元格/行/列 不會丟失數據; 拆分單元格內容; 合併重複的行/列...防止細胞重複; 比較範圍...
  • 選擇重複或唯一 行; 選擇空白行 (所有單元格都是空的); 超級查找和模糊查找 在許多工作簿中; 隨機選擇...
  • 確切的副本 多個單元格,無需更改公式參考; 自動創建參考 到多張紙; 插入項目符號,複選框等...
  • 提取文字,添加文本,按位置刪除, 刪除空間; 創建和打印分頁小計; 在單元格內容和註釋之間轉換...
  • 超級濾鏡 (將過濾方案保存並應用於其他工作表); 高級排序 按月/週/日,頻率及更多; 特殊過濾器 用粗體,斜體...
  • 結合工作簿和工作表; 根據關鍵列合併表; 將數據分割成多個工作表; 批量轉換xls,xlsx和PDF...
  • 超過 300 項強大的功能. 支持 Office / Excel 2007-2021 和 365。支持所有語言。 在您的企業或組織中輕鬆部署。 完整功能 30 天免費試用。 60 天退款保證。
kte選項卡201905

Office選項卡為Office帶來了選項卡式界面,使您的工作更加輕鬆

  • 在Word,Excel,PowerPoint中啟用選項卡式編輯和閱讀,發布者,Access,Visio和Project。
  • 在同一窗口的新選項卡中而不是在新窗口中打開並創建多個文檔。
  • 將您的工作效率提高 50%,每天為您減少數百次鼠標點擊!
officetab底部
按評論排序
留言 (33)
還沒有評分。 成為第一位評論!
網站主持人對此評論進行了最小化
您好,我想根據我的模板文件 Myformat 創建工作表,並根據第一列數據命名它們。 我自定義了 VBA 代碼如下,但它生成了太多的空白表。 你能幫我停止生成空白紙嗎? 謝謝你。 Kumar Sub AddSheets() Dim cell As Excel.Range Dim wsWithSheetNames As Excel.Worksheet Dim wbToAddSheetsTo As Excel.Workbook Set wsWithSheetNames = ActiveSheet Set wbToAddSheetsTo = ActiveWorkbook For Each cell in wsWithSheetNames.Range("A2:A165") With wbToAddSheetsTo .Sheets。添加之後:=ActiveSheet Sheets.Add 類型:= _ "C:\Users\Dimple\AppData\Roaming\Microsoft\Templates\MyFormat.xltx" On Error Resume Next ActiveSheet.Name = cell.Value If Err.Number = 1004 Then Debug.Print cell.Value & "已經用作工作表名稱" End If On Error GoTo 0 End With Next cell End Sub
網站主持人對此評論進行了最小化
嗨,
我總是在 A 行上的每個唯一條目獲得 2 張紙。 知道為什麼嗎? 此外,將生成的工作表創建的總行數添加到工作表名稱會有多困難。 非常感謝! 如果您接受捐款,請告訴我。
網站主持人對此評論進行了最小化
您好,我想使用我的 exel 文件模板 MyFormat 生成工作表並通過第一列上的數據命名工作表。 以下 VBA 代碼可以按照 MyFormat 生成工作表。 但它也在普通的 excel 模板上生成數百張空白頁。 可以請一些人幫助我停止生成多餘的空白紙。 感謝 Kumar Sub AddSheets() Dim cell As Excel.Range Dim wsWithSheetNames As Excel.Worksheet Dim wbToAddSheetsTo As Excel.Workbook Set wsWithSheetNames = ActiveSheet Set wbToAddSheetsTo = ActiveWorkbook For Each cell in wsWithSheetNames.Range("A2:A165") With wbToAddSheetsTo .Sheets .Add After:=ActiveSheet Sheets.Add Type:= _ "C:\Users\Dreamline\AppData\Roaming\Microsoft\Templates\MyFormat.xltx" On Error Resume Next ActiveSheet.Name = cell.Value If Err.Number = 1004然後 Debug.Print cell.Value & "已經用作工作表名稱" End If On Error GoTo 0 End With Next cell End Sub
網站主持人對此評論進行了最小化
工作表名稱的長度必須小於或等於 XNUMX 個字符。
不是很常見的知識,但否則代碼將輸出默認的空白“Sheet #”工作表。

創建一個新的工作表,您的解析代碼將運行它並引用第一列,如下所示:
=IF(OR('參考原稿'!B1<>"", LEN('參考原稿'!B1)>30), LEFT('參考原稿'!B1,30),'參考原稿'!B1)


盡可能複製或參考工作表的其餘部分。 如果您在引用其他工作表時遇到任何問題,請確保該列沒有數據驗證限制。
網站主持人對此評論進行了最小化
非常感謝你發布這個!!!! 像魅力一樣工作。 你能解釋一下第一組代碼是如何工作的嗎?
網站主持人對此評論進行了最小化
這次真是萬分感謝!



在 VBA 代碼中是否有從第一列和第二列行數據組合的結果表命名?



所以對於您的示例表 2 將自動命名為“linda 100”
網站主持人對此評論進行了最小化
親愛的喬伊斯,
謝謝你的評論! 希望下面的 VBA 腳本可以幫助你。

子 parse_data()
將 xRCount 變暗
將 xSht 調暗為工作表
將 xNSht 調暗為工作表
暗淡我只要
將 xTRrow 調暗為整數
Dim xCol 作為新系列
將 xTitle 調暗為字符串
在錯誤恢復下一頁
Application.ScreenUpdating = False
設置 xSht = ActiveSheet
xRCount = xSht.UsedRange.End(xlDown).Row
xTitle = "A1:B1"
xTRrow = xSht.Range(xTitle).Row
對於 I = 2 到 xRCount
調用 xCol.Add(CStr(xSht.Cells(I, 1)), CStr(xSht.Cells(I, 1)))
下一頁
調試打印 xCol.Count
對於 I = 1 到 xCol.Count
調用 xSht.Range(xTitle).AutoFilter(1, CStr(xCol.Item(I)))
設置 xNSht = 無
設置 xNSht = Worksheets(CStr(xCol.Item(I)))
如果 xNSht 什麼都不是,那麼
設置 xNSht = Worksheets.Add(, Sheets(Sheets.Count))
xNSht.Name = CStr(xCol.Item(I) & xSht.Cells(I + 1, 2))
其他
xNSht.Move , Sheets(Sheets.Count)
如果結束
xSht.Range("A" & xTRrow & ":A" & xRCount).EntireRow.Copy xNSht.Range("A1")
xNSht.Columns.AutoFit
下一頁
xSht.AutoFilterMode = False
xSht.激活
Application.ScreenUpdating = True
END SUB
網站主持人對此評論進行了最小化
這非常有幫助,正是我想要的。 謝謝!
網站主持人對此評論進行了最小化
這段代碼非常有用,幾乎是我想要的。
但是可以調整成有兩張紙嗎-
表 1 是數據 - 以 A 列為名稱的數據表
Sheet 2 是一個模板,有許多需要填寫的字段
我希望的是運行一個宏,它將
1 複製粘貼模板,在同一個文件中,將工作表命名為單元格 A1 中的名稱
2 複製單元格 B1 然後粘貼到新模板中的選定字段
3 沿第 1 行重複直到空
4 然後重複第 2 行和每一行直到結束。
結果是一個帶有 x 號的文件。 工作表與模板相同,所有字段均已填寫。
我繼承了一個以另一種方式工作的文件,將數據從模板提取到表中,但無法反轉它.....
網站主持人對此評論進行了最小化
親愛的山姆,
如果您可以在此處附上您的工作簿,那就太好了。
您可以使用下面的上傳文件按鈕上傳您的文件。
網站主持人對此評論進行了最小化
您好,我嘗試使用您的代碼,但出現錯誤
運行時錯誤“1004”:
應用程序定義或對象定義的錯誤
我對 VBA(或任何相關技術)一無所知,但如果按調試它會突出顯示第 11 行 xRCount=xSht.Cells(xSht.Rows.Count,1)。 結束(xIUp).Row
我正在處理一個有 127 列和 337 行的大文件(行會改變列不會),它是一個包含我的數字及其詳細信息的列表。
我確實按照您的說明更改了範圍,但仍然無法正常工作我正在使用 Excel 2010,如果可能的話,您能否告訴我如何使其工作
謝謝
網站主持人對此評論進行了最小化
親愛的比阿特麗斯,
代碼隨問題解決而更新。 請再試一次。 感謝您的評論。
網站主持人對此評論進行了最小化
你好,我認為這裡有一些對我的情況有用的東西,但我可以做 VBA 或腳本,希望你能提供幫助。
我有一個帶有許多單元格的模板來填充數據,並且會有一個我想輸入到模板中的搜索鍵(非唯一)。 根據搜索關鍵字,對數據進行搜索,並取出匹配關鍵字上的對應數據並填充到模板中。 填充的模板被保存到一個新的工作表中。 可能有超過 1 個匹配條目。 我需要腳本繼續在列表中搜索,直到選擇了所有匹配項並創建了一定數量的新工作表。
網站主持人對此評論進行了最小化
嗨,有沒有辦法在每個新工作表上保留標題行? (在我的附件中用紅色圈出)

該代碼從我的主工作表中獲取所有行並將它們轉移到新的工作表中,這很棒。 但我想在每個新工作表的頂部保留我的“主”標題值(以紅色圈出)。 謝謝!



我指的是上面的這段代碼:

子 RowToSheet()
將 xRow 變暗
暗淡我只要
使用ActiveSheet
xRow = .Range("A" & Rows.Count).End(xlUp).Row
對於 I = 1 到 xRow
Worksheets.Add(, Sheets(Sheets.Count)).Name = "Row" & I
.Rows(I).Copy Sheets("Row" & I).Range("A1")
接下來我
結束
END SUB
網站主持人對此評論進行了最小化
很棒的代碼,但是如果我的數據在 G 列而不是 A 列上,我能得到一些幫助嗎? 我需要更改什麼才能將 G 列數據放在不同的選項卡中?

謝謝
網站主持人對此評論進行了最小化
這是很棒的代碼。 非常感謝 OfficeExtend 的大腦盒! 無論如何,這段代碼是否可以稍微適應為每個 *column* 而不是行創建單獨的工作表? 我附上了一張我正在努力實現的圖片。 這可能嗎? 親切的問候。
網站主持人對此評論進行了最小化
美好的一天,
我在這裡沒有看到你的照片。
網站主持人對此評論進行了最小化
嗨,如果我的名字字段在C列,如何修改代碼
網站主持人對此評論進行了最小化
嗨,阿卜杜勒·巴斯特,
下面的 VBA 代碼可以幫助你。 請試一試。
行中:xCName = "3",3表示Excel中的列號(這裡是C列)。 您可以根據需要將其更改為任何列號。

子 parse_data()
'更新 Extendoffice 2018/3/2
將 xRCount 變暗
將 xSht 調暗為工作表
將 xNSht 調暗為工作表
暗淡我只要
將 xTRrow 調暗為整數
Dim xCol 作為新系列
將 xTitle 調暗為字符串
將 xSUpdate 調暗為布爾值
將 xCName 調暗為整數
將 xTA、xRA、xSRg1 調暗為字符串
設置 xSht = ActiveSheet
在錯誤恢復下一頁
xRCount = xSht.Cells(xSht.Rows.Count, 1).End(xlUp).Row
xTitle = "A1:C1"
xCName = "3" '將此編號更改為您將根據其創建新工作表的列號
xTRrow = xSht.Range(xTitle).Cells(1).Row
對於 I = 2 到 xRCount
調用 xCol.Add(xSht.Cells(I, xCName).Text, xSht.Cells(I, xCName).Text)
下一頁
xSUpdate = Application.ScreenUpdating
Application.ScreenUpdating = False
xSRg = xSht.Cells(1, xCName).Address(RowAbsolute:=False, ColumnAbsolute:=False)
對於 I = 1 到 xCol.Count
調用 xSht.Range(xTitle).AutoFilter(xCName, CStr(xCol.Item(I)))
設置 xNSht = 無
設置 xNSht = Worksheets(CStr(xCol.Item(I)))
如果 xNSht 什麼都不是,那麼
設置 xNSht = Worksheets.Add(, Sheets(Sheets.Count))
xNSht.Name = CStr(xCol.Item(I))
其他
xNSht.Move , Sheets(Sheets.Count)
如果結束
xSht.Range("A" & xTRrow & ":A" & xRCount).EntireRow.Copy xNSht.Range("A1")
xNSht.Columns.AutoFit
下一頁
xSht.AutoFilterMode = False
xSht.激活
Application.ScreenUpdating = xSUpdate
END SUB
網站主持人對此評論進行了最小化
很酷的 VBA 代碼可以解決問題。

如何將其修改為不復制第一列? 並刪除列名?

問候
網站主持人對此評論進行了最小化
請我獲得有關如何使用特定列自動命名工作表的幫助。 這是用於工作表 VBA 的行。 見下文

子 RowToSheet()

將 xRow 變暗

暗淡我只要

使用ActiveSheet

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

對於 I = 1 到 xRow

Worksheets.Add(, Sheets(Sheets.Count)).Name = "Row" & I

.Rows(I).Copy Sheets("Row" & I).Range("A1")

接下來我

結束

END SUB
網站主持人對此評論進行了最小化
沒關係,它是隱藏的尾隨空格。 我使用了 TRIM 功能並對其進行了清理。 有一個行數(行數確實如此,所以在工作表前面加上行 -1 會很棒)
網站主持人對此評論進行了最小化
如何參考上面代碼的使用(信用)? 是否可以修改代碼?
網站主持人對此評論進行了最小化
你好,這是一個開放的交流平台。 代碼允許引用和修改。
網站主持人對此評論進行了最小化
娜娜
86
2
網站主持人對此評論進行了最小化
你好! 我剛剛使用了這段代碼,它奏效了! 除了為每個條目創建一個新工作表之外,我還想將其轉換為列並且無法弄清楚。 所以對於上面的例子,娜娜的輸出看起來像這樣 - 姓名 娜娜得分 86沒有 2
網站主持人對此評論進行了最小化
您好,使用此代碼並且工作,但是如果我想在標題中選擇多於一行,代碼中會有什麼變化? 我在每張紙上都有我想要的多行。
網站主持人對此評論進行了最小化
你好,你知道怎麼做嗎?
網站主持人對此評論進行了最小化
嗨,是否有一個代碼在每次運行宏時只添加 1 個新工作表,例如,第一次新工作表將在單元格 A1 的內容上命名,第二次運行宏時,新工作表將在A1等的內容感謝期待
這裡還沒有評論
載入更多
留下你的意見
以訪客身份發帖
×
評價此帖子:
0   字符
推薦地點

關注我們

版權所有©2009 - 萬維網。extendoffice.com。 | 版權所有。 供電 ExtendOffice。 |
Microsoft和Office徽標是Microsoft Corporation在美國和/或其他國家的商標或註冊商標。
受Sectigo SSL保護