Excel의 열을 기반으로 데이터를 여러 워크 시트로 분할하는 방법은 무엇입니까?

방대한 데이터 행이 포함 된 워크 시트가 있다고 가정하고 이제 데이터를 다음을 기반으로 여러 워크 시트로 분할해야합니다. 성함 열 (다음 스크린 샷 참조) 및 이름이 무작위로 입력됩니다. 먼저 정렬 한 다음 하나씩 복사하여 다른 새 워크 시트에 붙여 넣을 수 있습니다. 그러나 반복해서 복사하여 붙여 넣으려면 인내심이 필요합니다. 오늘은이 작업을 해결하기위한 몇 가지 빠른 트릭에 대해 이야기하겠습니다.

열로 문서 분할 데이터 1

VBA 코드가있는 열을 기반으로 데이터를 여러 워크 시트로 분할

Excel 용 Kutools를 사용하여 열을 기반으로 데이터를 여러 워크 시트로 분할

VBA 코드가있는 열을 기반으로 데이터를 여러 워크 시트로 분할

열 값을 기준으로 데이터를 빠르고 자동으로 분할하려면 다음 VBA 코드를 선택하는 것이 좋습니다. 다음과 같이하십시오 :

1. 누르고 ALT + F11 키를 눌러 응용 프로그램 용 Microsoft Visual Basic 창.

2. 딸깍 하는 소리 끼워 넣다 > 모듈을 클릭하고 모듈 창에 다음 코드를 붙여 넣습니다.

Sub Splitdatabycol()
'updateby Extendoffice
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
On Error Resume Next
Set xTRg = Application.InputBox("Please select the header rows:", "Kutools for Excel", "", Type:=8)
If TypeName(xTRg) = "Nothing" Then Exit Sub
Set xVRg = Application.InputBox("Please select the column you want to split data based on:", "Kutools for Excel", "", 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(1).Row
icol = ws.Columns.Count
ws.Cells(1, icol) = "Unique"
Application.DisplayAlerts = False
If Not Evaluate("=ISREF('xTRgWs_Sheet!A1')") Then
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = "xTRgWs_Sheet"
Else
Sheets("xTRgWs_Sheet").Delete
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = "xTRgWs_Sheet"
End If
Set xWSTRg = Sheets("xTRgWs_Sheet")
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
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
Else
Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
End If
xWSTRg.Range(title).Copy
Sheets(myarr(i) & "").Paste Destination:=Sheets(myarr(i) & "").Range("A1")
ws.Range("A" & (titlerow + xTRg.Rows.Count) & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A" & (titlerow + xTRg.Rows.Count))
Sheets(myarr(i) & "").Columns.AutoFit
Next
xWSTRg.Delete
ws.AutoFilterMode = False
ws.Activate
Application.DisplayAlerts = True
End Sub

3. 그런 다음, F5 키를 눌러 코드를 실행하면 헤더 행을 선택하라는 메시지 상자가 나타납니다. 스크린 샷을 참조하십시오.

열로 문서 분할 데이터 7

4. 그런 다음 OK 버튼을 누르고 두 번째 프롬프트 상자에서 분할 할 열 데이터를 선택하십시오. 스크린 샷을 참조하십시오.

열로 문서 분할 데이터 8

5. 그런 다음 OK, 활성 워크 시트의 모든 데이터는 열 값을 기준으로 여러 워크 시트로 분할됩니다. 그리고 분할 워크 시트의 이름은 분할 셀 이름으로 지정됩니다. 스크린 샷보기 :

열로 문서 분할 데이터 2

주의 사항: 분할 워크 시트는 마스터 워크 시트가있는 통합 문서의 끝에 배치됩니다.

Excel 용 Kutools를 사용하여 열을 기반으로 데이터를 여러 워크 시트로 분할

Excel 초보자로서이 긴 VBA 코드는 우리에게 다소 어렵고 우리 대부분은 필요에 따라 코드를 수정하는 방법을 모릅니다. 여기에서는 다기능 도구를 소개합니다.Excel 용 Kutools그 데이터 분할 유틸리티는 열을 기준으로 데이터를 여러 워크 시트로 분할하는 데 도움이 될뿐만 아니라 행 수를 기준으로 데이터를 분할 할 수도 있습니다.

참고 :이것을 적용하려면 데이터 분할, 먼저 Excel 용 Kutools을 클릭 한 다음 기능을 빠르고 쉽게 적용하십시오.

설치 후 Excel 용 Kutools, 다음과 같이하십시오.

1. 분할 할 데이터 범위를 선택하십시오.

2. 딸깍 하는 소리 쿠툴즈 플러스 > 워크 시트 > 데이터 분할, 스크린 샷 참조 :

열로 문서 분할 데이터 3

3. 에서 데이터를 여러 워크 시트로 분할 대화 상자에서 다음을 수행해야합니다.

1). 고르다 특정 열 에서 옵션 기준 분할 섹션을 클릭하고 드롭 다운 목록에서 데이터를 분할 할 열 값을 선택합니다. (데이터에 헤더가 있고이를 각각의 새 분할 워크 시트에 삽입하려면 내 데이터에 헤더가 있습니다. 선택권.)

2). 그런 다음 분할 워크 시트 이름을 지정할 수 있습니다. 새 워크 시트 이름 섹션에서 워크 시트 이름 규칙을 지정합니다. 규칙 드롭 다운 목록에서 접두사 or 접미사 시트 이름도 마찬가지입니다.

3). 클릭 OK 단추. 스크린 샷보기 :

열로 문서 분할 데이터 4

4. 이제 데이터가 새 통합 문서에서 여러 워크 시트로 분할됩니다.

열로 문서 분할 데이터 5

Excel 용 Kutools 및 무료 평가판을 지금 다운로드하려면 클릭하십시오!

Excel 용 Kutools를 사용하여 열을 기반으로 데이터를 여러 워크 시트로 분할

Excel 용 Kutools 300 개 이상의 편리한 Excel 도구가 포함되어 있습니다. 30 일 동안 제한없이 무료로 사용해보세요. 지금 무료 평가판을 다운로드하십시오!

최고의 사무 생산성 도구

Excel 용 Kutools는 대부분의 문제를 해결하고 생산성을 80% 향상시킵니다.

재사용: 빠르게 삽입 복잡한 공식, 차트 그리고 이전에 사용한 모든 것; 셀 암호화 암호로; 메일 링리스트 생성 이메일 보내기 ...
슈퍼 포뮬러 바 (여러 줄의 텍스트와 수식을 쉽게 편집 할 수 있습니다.) 레이아웃 읽기 (많은 수의 셀을 쉽게 읽고 편집합니다.) 필터링 된 범위에 붙여 넣기...
셀 / 행 / 열 병합 데이터 손실없이; 셀 내용 분할; 중복 행 / 열 결합... 중복 셀 방지; 범위 비교...
중복 또는 고유 선택 행; 빈 행 선택 (모든 셀이 비어 있음); 슈퍼 찾기 및 퍼지 찾기 많은 통합 문서에서; 무작위 선택 ...
정확한 사본 수식 참조를 변경하지 않고 여러 셀; 참조 자동 생성 여러 시트에; 글 머리 기호 삽입, 확인란 등 ...
텍스트 추출, 텍스트 추가, 위치 별 제거, 공간 제거; 페이징 부분합을 만들고 인쇄합니다. 셀 내용과 주석 간 변환...
슈퍼 필터 (다른 시트에 필터 구성표 저장 및 적용) 고급 정렬 월 / 주 / 일, 빈도 등 특수 필터 굵은 기울임 꼴로 ...
통합 문서와 워크 시트 결합; 키 열을 기반으로 테이블 병합; 데이터를 여러 시트로 분할; xls, xlsx 및 PDF 일괄 변환...
300개 이상의 강력한 기능. Office / Excel 2007-2019 및 365를 지원합니다. 모든 언어를 지원합니다. 기업 또는 조직에 쉽게 배포 할 수 있습니다. 전체 기능 30 일 무료 평가판. 60 일 환불 보장.

자세히보기 ... 무료 다운로드... 매수...

Office Tab은 Office에 탭 인터페이스를 제공하여 작업을 훨씬 쉽게 만듭니다.

Word, Excel, PowerPoint에서 탭 편집 및 읽기 사용, Publisher, Access, Visio 및 Project.
새 창이 아닌 동일한 창의 새 탭에서 여러 문서를 열고 만듭니다.
생산성이 50% 증가하고 매일 수백 번의 마우스 클릭이 줄어듭니다!

자세히보기 ... 무료 다운로드... 매수...

287 Comments
Login

Sort by Newest
- Best
- Popular
- Newest
- Oldest

You are guest

or post as a guest, but your post won't be published automatically.

Loading comment... The comment will be refreshed after 00:00.

To post as a guest, your comment is unpublished.
Travelermatt · 3 years ago
Hi, great time saver, thanks. I know it is an old post but hopefully someone can help.

My table needs splitting based on column 1, but column 1 contains dates and the result is that each new sheet doesnt contain any data. It creates the right amount of sheets but doesnt move any data. Any Ideas?
- Reply
- To post as a guest, your comment is unpublished.
  skyyang · 3 years ago
  
  Hello, Carrington,
  To split the data based on the date column, you should use the following vba code, but, this code is only applied to date column correctly, if your key column is normal data, please use the code in this article.
  Sub parseData_Date()
  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 xName As String
  Dim xValue As String
  Dim xArrFind As Variant
  Dim xStrReplace As String
  Dim xFNum As Integer
  Dim xRg As Range
  Set ws = Sheets("Master sheet")
  xArrFind = Array(":", "\", "/", "?", "*", "[", "]")
  xStrReplace = "_"
  vcol = 1
  lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
  title = "A1:C1"
  titlerow = ws.Range(title).Cells(1).Row
  icol = ws.Columns.Count
  ws.Cells(1, icol) = "Unique"
  On Error Resume Next
  For i = 2 To lr
  If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
  Set xRg = ws.Cells(i, vcol)
  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)
  xValue = ""
  xValue = myarr(i)
  xValue = FormatDateTime(xValue)
  xName = xValue
  For xFNum = 0 To UBound(xArrFind)
  xName = Replace(xName, xArrFind(xFNum), xStrReplace)
  Next xFNum
  ws.Range(title).AutoFilter field:=vcol, Criteria1:=xValue & ""
  If Not Evaluate("=ISREF('" & xName & "'!A1)") Then
  Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = xName & ""
  Else
  Sheets(xName & "").Move After:=Worksheets(Worksheets.Count)
  End If
  ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(xName & "").Range("A1")
  Sheets(xName & "").Columns.AutoFit
  Next
  ws.AutoFilterMode = False
  ws.Activate
  End Sub
  
  Please try it, hope it can help you!
  
  Reply
To post as a guest, your comment is unpublished.
Nilesh · 15 days ago
Thank you so much.
- Reply
To post as a guest, your comment is unpublished.
Tom · 28 days ago
The Kutools split function does not work.
I have a file with over 10 million cells (180 000 rows adn 63 columns). I am trying to split the data into 12 sheets based on name in one column.
Does the Kutool have a limitation on the number of cells it can split?
- Reply
To post as a guest, your comment is unpublished.
Tom · 28 days ago
The Kutools split function does not work.
I have a file with over 10million cells (180 000 rows and 63 columns). I am trying to split them into 12 sheet based on name in one column.
Does the Kutool have a limitation on the number of cells it can split?
- Reply
To post as a guest, your comment is unpublished.
Ashley Abston · 3 months ago
Does this VBA code not work if there are other characters like -, () are in the column that we want to split? If not, how can I update the code to control for that?
- Reply
To post as a guest, your comment is unpublished.
ciot · 7 months ago
hi,I 've to do un upgrade in this code. More specific, i have a Dataset("Data") to split in multiple sheet and this code it's good to me. But in my new sheet i don't want all column from the orignal data but only specific column. How can i do?
- Reply
To post as a guest, your comment is unpublished.
Vanessa · 7 months ago
Hi there, is there a limit on the number of rows in the worksheet you need to split?

I have 150,000 rows, that need to be split into diff worksheets based on name of company - this VBA is not working
- Reply
- To post as a guest, your comment is unpublished.
  poorna · 1 months ago
  
  Just make integer to long macros will work fine
  
  Reply
- To post as a guest, your comment is unpublished.
  skyyang · 7 months ago
  
  Hello, Vanessa,
  If you have tens of thousands rows data need to be split, I will recommend you to use the Kutools for Excel's Split Data feature, with this feature, you can achieve the job quickly and easily. You can download and free trail 30 days. Please try, thank you!
  
  Reply
To post as a guest, your comment is unpublished.
Courtney · 7 months ago
Is there anyway to do this in a way that will maintain the page layout/print set up? header, footer, gridlines, repeat rows, lanscape, narrow margins, fit columns on page, etc?
- Reply
To post as a guest, your comment is unpublished.
MIke Merker · 8 months ago
Just used this today and the VB Script was exactly what I needed. Thank you!
- Reply
To post as a guest, your comment is unpublished.
Alberto · 11 months ago
Hello, I could split the data base! thanks! :)
But is there any option to keep transferred datas to each excel sheet, if the master sheet is updating daily?
- Reply
To post as a guest, your comment is unpublished.
Uros D. · 11 months ago
Hi, question, is there a good way to ONLY bring in certain columns to the split sheets, instead of all?
- Reply
To post as a guest, your comment is unpublished.
Jesse · 11 months ago
Dude this is brilliant....saved me many hours of work. Thank you.
- Reply
To post as a guest, your comment is unpublished.
JD · 1 years ago
Nothing happens. I run the code, it prompts me for the header & column info, I input it, and then nothing. Not even an error to point me in the right direction.
- Reply
- To post as a guest, your comment is unpublished.
  EG · 11 months ago
  
  I'm running into the same issue.
  
  Reply
To post as a guest, your comment is unpublished.
Pratik Trivedi · 1 years ago
Hi Team,

Thank you so much for this code it has helped me over the last few months amazingly.

However, since last month this code has not working for me. It only creates sheets with the name but data, format as well as headers are not carrying over.

I have changed my computer though not sure if this has to do something with it. I have been using the same code and steps as specified above.

Please help!

Thank You!
- Reply
To post as a guest, your comment is unpublished.
Dom27 · 1 years ago
Hello.

I Have problem with borders. In each new table the bottom border is missing.
Have you got some solution please?
- Reply
To post as a guest, your comment is unpublished.
soo.kim · 1 years ago
How can I change to have it paste starting at cell a10 instead of a1 on the new sheets?
- Reply
To post as a guest, your comment is unpublished.
Jaco van der Merwe · 1 years ago
Hi there,
Thank you so much for this post. It is really very helpful.

I have another situation that requires me to split salary data per department so that each manager will receive a workbook for their team only. I do not mail these out to managers, I simply safe it in their respective folder on the server.

I use this code, but this code does not split the worksheet into separate files. Can you please help me to modify this code so that it will create separate workbooks for me in the same directory as the master sheet?

Sub SplitIntoSheets()
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
ThisWorkbook.Activate
Sheet1.Activate
'clearing filter if any
On Error Resume Next
Sheet1.ShowAllData
On Error GoTo 0
Dim lsrClm As Long
Dim lstRow As Long
'counting last used row
lstRow = Cells(Rows.Count, 1).End(xlUp).Row
Dim Planners As Range
Dim clm As String, clmNo As Long
On Error GoTo handler
clm = Application.InputBox("From which column you want create files" & vbCrLf & "E.g. A,B,C,AB,ZA etc.")
clmNo = Range(clm & "1").Column
Set Planners = Range(clm & "2:" & clm & lstRow)
'Calling Remove Duplicates to Get Unique Names
Set Planners = RemoveDuplicates(Planners)
Call CreateSheets(Planners, clmNo)
With Application
.ScreenUpdating = True
.DisplayAlerts = True
.AlertBeforeOverwriting = True
.Calculation = xlCalculationAutomatic
End With
Sheet1.Activate
MsgBox "Well Done!"
Exit Sub
Data.ShowAllData
handler:
With Application
.ScreenUpdating = True
.DisplayAlerts = True
.AlertBeforeOverwriting = True
.Calculation = xlCalculationAutomatic
End With
End Sub
Function RemoveDuplicates(Planners As Range) As Range
ThisWorkbook.Activate
Sheets.Add
On Error Resume Next
ActiveSheet.Name = "Planners"
Sheets("Planners").Activate
On Error GoTo 0
Planners.Copy
Cells(2, 1).Activate
ActiveCell.PasteSpecial xlPasteValues
Range("A1").Value = "Planners"
Dim lstRow As Long
lstRow = Cells(Rows.Count, 1).End(xlUp).Row
Range("A2:A" & lstRow).Select
ActiveSheet.Range(Selection.Address).RemoveDuplicates Columns:=1, Header:=xlNo
lstRow = Cells(Rows.Count, 1).End(xlUp).Row
Set RemoveDuplicates = Range("A2:A" & lstRow)
End Function
Sub CreateSheets(Planners As Range, clmNo As Long)
Dim lstClm As Long
Dim lstRow As Long

For Each Unique In Planners
Sheet1.Activate
lstRow = Cells(Rows.Count, 1).End(xlUp).Row
lstClm = Cells(1, Columns.Count).End(xlToLeft).Column
Dim dataSet As Range
Set dataSet = Range(Cells(1, 1), Cells(lstRow, lstClm))
dataSet.AutoFilter field:=clmNo, Criteria1:=Unique.Value
lstRow = Cells(Rows.Count, 1).End(xlUp).Row
lstClm = Cells(1, Columns.Count).End(xlToLeft).Column
Debug.Print lstRow; lstClm
Set dataSet = Range(Cells(1, 1), Cells(lstRow, lstClm))
dataSet.Copy
Sheets.Add
ActiveSheet.Name = Unique.Value2
ActiveCell.PasteSpecial xlPasteAll
Next Unique
End Sub
- Reply
- To post as a guest, your comment is unpublished.
  skyyang · 1 years ago
  
  Hello, Jaco,
  To split the data into multiple separate workbooks based on the column value, the code in the following article may help you:
  https://www.datanumen.com/blogs/2-fast-means-to-split-an-excel-worksheets-contents-into-multiple-workbooks-based-on-a-specific-column/
  
  Please try it, thank you!
  
  Reply
To post as a guest, your comment is unpublished.
Ani · 1 years ago
Hi, it is working great but I need to keep the header row and the infromation above it in each sheet and also the formatting of the header row.
Does anyone know how this can happen?
- Reply
To post as a guest, your comment is unpublished.
Joe · 1 years ago
This is awesome!! Thank you so much for sharing!
- Reply
To post as a guest, your comment is unpublished.
Kevin · 1 years ago
Hey, i really need some help.
1. first i want to to split based on value and after that to split per 1k based on value before.
2. After split per 1k, i need to save as those files to xls.

Can someone help me to solve thats problem
- Reply
To post as a guest, your comment is unpublished.
nk · 1 years ago
This macro has come in handy more times than i can count, Does anyone have a work around for these two issues? Any help is appreciated!

1. make the Macro work form a worksheet that is formatted as a table and maintain the same formatting in the new worksheets? I have been able to use this macro when the worksheet is not formatted.

2. split columns that Include blank cells from the original worksheet to the new worksheets. My original data has some empty cells, that need to remain empty, when i use this macro, the divided columns exclude the data that had an empty cell in the column that was split.
- Reply
To post as a guest, your comment is unpublished.
NK · 1 years ago
This macro has come in handy more times than i can count, Does anyone have a work around for these two issues? Any help is appreciated!

1. make the Macro work form a worksheet that is formatted as a table and maintain the same formatting in the new worksheets? I have been able to use this macro when the worksheet is not formatted.

2. split columns that Include blank cells from the original worksheet to the new worksheets. My original data has some empty cells, that need to remain empty, when i use this macro, the divided columns exclude the data that had an empty cell in the column that was split.
- Reply
To post as a guest, your comment is unpublished.
AshSam123 · 1 years ago
Hey everyone. I am completely new to VBA. I have an account receivable data in an excel sheet and there are multiple column. One column mention the invoice no and the other mentions the department responsible for that invoice. I have tried this code, it split the column by department into multiple sheets but it does not include the invoice no. I have a big list of data and I don't to want copy and paste the data, can someone please help me. Thanks
- Reply
- To post as a guest, your comment is unpublished.
  AshSam123 · 1 years ago
  
  Thank you for your response. I cannot post the original, but here is the sample data. I hope you can help me. Many Thanks
  
  Reply
- To post as a guest, your comment is unpublished.
  skyyang · 1 years ago
  
  Hi, Ayesha,
  Could you upload your problem screenshot here? Thank you!
  
  Reply
To post as a guest, your comment is unpublished.
Guest25 · 1 years ago
The vba code is not working if the column values to split on has a length of 26. If I manually change it to 12 it works. Is there a reason for it. I understand that excel worksheet name cannot exceed 30 characters but here the length is 26 but it does not work. Can you please help me understand this. Thanks.
- Reply
- To post as a guest, your comment is unpublished.
  skyyang · 1 years ago
  
  Hello,
  Thank you for your comment, yes, as you said, the above vba code is not worked correctlly for cell values which text length are much longer, but, here, you can apply our product, Kutools for Excel, with its Split Data feature, you can achieve this job quickly and easily. You can download and free trail 30 days. Please try, thank you!
  
  Reply
To post as a guest, your comment is unpublished.
Melvin · 2 years ago
the code to split the data works perfectly, except it skips some data and renames these as "sheet#"
- Reply
To post as a guest, your comment is unpublished.
sha · 2 years ago
thank you very much, it helped me a lot in my work. However, is there a way to have the macro create a separate spreadsheet for each new tab instead of just adding a tab into the current worksheet? Thanks!
- Reply
- To post as a guest, your comment is unpublished.
  skyyang · 2 years ago
  
  Hi,
  If you want to save each sheet as a new workbbok based on the column value, the following articles may help you! Please check:
  
  https://www.extendoffice.com/documents/excel/2734-excel-split-data-into-multiple-workbooks.html
  https://www.datanumen.com/blogs/2-fast-means-to-split-an-excel-worksheets-contents-into-multiple-workbooks-based-on-a-specific-column/
  
  Reply
To post as a guest, your comment is unpublished.
G · 2 years ago
How can I make it to automatically choose a smaller name for the sheet instead of skipping an entry and returning sheet 4, sheet 5 etc.

E.G: I am using this amazing code to dissect my excel sheet, but some entries have a long name which exceeds the sheet name count, instead of using all 31 symbols that are allowed, it cancels the filtering and returns sheet 4 instead.
- Reply
To post as a guest, your comment is unpublished.
K · 2 years ago
Could I make it so that I would be able to automatically split it so both Emily and Lucy's are in one page, and Jone and Steven's are in another?
- Reply
- To post as a guest, your comment is unpublished.
  skyyang · 2 years ago
  
  Hi,
  Sorry, at present, maybe there is not a good method for solving your problem. But you can combine the two sheets you need after splitting.
  
  Reply
To post as a guest, your comment is unpublished.
Mark · 2 years ago
This works great but is there a way I can carry over my formulas from the original worksheet?
- Reply
- To post as a guest, your comment is unpublished.
  skyyang · 2 years ago
  
  Hi, Mark,
  The above VBA code helps to keep the formula cells after splitting the data, please try!
  Thank you!
  
  Reply
  
  To post as a guest, your comment is unpublished.
  Mark · 2 years ago
  
  Works great!
  
  Thanks for all your help!
  
  Reply
To post as a guest, your comment is unpublished.
Bernhard · 2 years ago
Thank you, worked excellently!
- Reply
To post as a guest, your comment is unpublished.
Degardt · 2 years ago
This code is brilliant. It does exactly what I need. Only, I don't know how to change the code so that the data in the rows, all starting with the same letter, should go on the same worksheet, instead of each getting its own worksheet. I have 1000 rows of data, some starting with "L", or "K"or "F" and then a number. It sorts the data each to its own sheet, I want all the "L" cells' data on one sheet and all the"K" data on one sheet. Can someone please help me. I don't underwstand coding that good
- Reply
- To post as a guest, your comment is unpublished.
  MP · 2 years ago
  
  Add a column and pull the first character from the cell with L+ the number or K+ the number. Assume your key is in cell A2, use the formula =left(A2,1) to pull the first character into your new column. Use this column to separate data to its own sheet.
  
  Reply
  
  To post as a guest, your comment is unpublished.
  Degardt · 2 years ago
  
  Thank you MP, I will definitely try that. I'm new to coding and still trying to figure it out as I go. But it's crunch time and i need the program to work ASAP. For now I'm just struggling a bit. Lol
  
  Reply
To post as a guest, your comment is unpublished.
Aaron · 2 years ago
Why does the VBA create new sheets with columns all the way to XFD when my main sheet only goes to AK?
- Reply
To post as a guest, your comment is unpublished.
ShiroKuro · 2 years ago
how do i make this work on around 150k rows count. Thanks
- Reply
- To post as a guest, your comment is unpublished.
  skyyang · 2 years ago
  
  Hello, ShiroKuro,
  If there are large data in your worksheet, I recommend Kutools for Excel's Split Data feature for you, you can download it and free trial 60-day!
  Please try, thank you!
  
  Reply
To post as a guest, your comment is unpublished.
adityabhatnagar2103@gmail.com · 2 years ago
Great script! Could someone please help as I need to just add "Class-C" at the end of each new worksheet's name that is created after running this. For Eg. Lucy-Class C; Emily Class C; and so on. Would really appreciate your help here.
- Reply
- To post as a guest, your comment is unpublished.
  Me · 2 years ago
  
  just add a column and concatenate the Name and the "-Class C" field and use that as the column to split on instead of the Name column, then you can hide the column if you want
  
  Reply
- To post as a guest, your comment is unpublished.
  skyyang · 2 years ago
  
  Hello, Aditya,
  Here, I recommend Kutools for Excel's Split Data feature for you, you can add the prefix or suffix text easily in the dialog box as you need.
  You can download the tool and free trial 60-day.
  Please try, thank you!
  
  Reply
To post as a guest, your comment is unpublished.
Katharina · 2 years ago
Great Script, thanks! What do I have to do to set the header row range and column to use for grouping/splitting within the script? I know it is more elegant to use selectable parameters but for my use case it is always the same. As I do know nothing about VBA, any little hint is appreciated :-) Best, Katharina
- Reply
To post as a guest, your comment is unpublished.
daiana · 2 years ago
It doesn't work with 120000 rows. Is there any way to make it work?
- Reply
To post as a guest, your comment is unpublished.
Radoslav · 2 years ago
Perfect!!! Works and refer to all my demands. Tnx for that source code.
- Reply
To post as a guest, your comment is unpublished.
Rudi Miller · 2 years ago
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 = 1
Set ws = Sheets("Sheet1")
lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
title = "A1:C1"
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
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
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
Else
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
Next
ws.AutoFilterMode = False
ws.Activate
End Sub
- Reply
To post as a guest, your comment is unpublished.
Jason · 3 years ago
This formula is great, works perfectly for me.
I want to split out data based on a location, which is in column 1. Which this does.
However, is it possible to also split out based on column 2, for example. Built and Not Built. So a secondary condition also?
- Reply
To post as a guest, your comment is unpublished.
jose · 3 years ago
can someone help please im using this but i keep getting to many columns. i have to keep deleting rows every time i use this.

This is what im using

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 = 1
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
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
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
Else
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
Next
ws.AutoFilterMode = False
ws.Activate
End Sub
- Reply
To post as a guest, your comment is unpublished.
itsavinash · 3 years ago
Thanks for VBA, it works great. In addition to that question, I have column which is dependent. So when i select some value my column values get changed hence I need vba solution to replace earlier split worksheet to replace with new value of columns. Can anyone help me out.?

Thanks in advance
- Reply
To post as a guest, your comment is unpublished.
JP Tontegode · 3 years ago
Is there a way to have the macro create a separate spreadsheet for each new tab instead of just adding a tab into the current worksheet? Thanks!
- Reply
To post as a guest, your comment is unpublished.
Sebastian · 3 years ago
Effectively, this code does work great. I wrote an additional code so that I could get subtotal on certain columns but it has not worked great. So I tried running the subtotals from the master list, but afterwards when I use this macro it create a whole new tab for the Grand total row. So I am getting two two tabs per split. the first one is fine because it splits with the grand totals, but then creates a second one with just the grand total row. Any help as to how to modify this.
This is the code that I am currently using:
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 = 3
Set ws = Sheets("Master sheet")
lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
title = "A1:R1"
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
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
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
Else
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
Next
ws.AutoFilterMode = False
ws.Activate
End Sub
- Reply
To post as a guest, your comment is unpublished.
Jenny Singleton · 3 years ago
Hi, This VBA worked great on my first attempt. However, when repeating the process with a new set of data, the sheets are splitting into Product names, but the data in each sheet still shows all data. I can't understand why it worked first time though. Can anyone help please. Thanks
- Reply
To post as a guest, your comment is unpublished.
Trisha · 3 years ago
This code is brilliant - Thank you. Just one thing - its splitting the data as I need it too but amongst creating the relevant sheets its creating blank sheets too.

Are you able to help with this?
- Reply
To post as a guest, your comment is unpublished.
aaseef.khan@gmail.com · 3 years ago
Thanks for the Magic Words
- Reply
To post as a guest, your comment is unpublished.
Muhammad Jahanzaib · 3 years ago
Thanks for excellent & brilliant code. I came across a bug, if field name is too long, the new sheet is not created. It should be like that the new sheet may be named with the maximum number of characters allowed. Regards,
- Reply
To post as a guest, your comment is unpublished.
Alex S · 3 years ago
To anyone having issues with long sheet names (ie Sheet Names greater than 30 characters), replace:

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) & ""
Else
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
Next

with

Dim sheetName As String
For i = 2 To UBound(myarr)
ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
' Replace the below assignment to sheetName as you wish
sheetName = Left(CStr(i - 1) & "_" & myarr(i), 30)
If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = sheetName
Else
Sheets(sheetName).Move after:=Worksheets(Worksheets.Count)
End If
ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(sheetName).Range("A1")
Sheets(sheetName).Columns.AutoFit
Next

This essentially limits the Sheet Name to legal limits of 30 characters. If you do not like the way the sheet is named, replace sheetName's assignment whatever you would like, keeping in mind that no two sheets can have the exact same name and must also be 30 characters or less.

You can also remove the filtering that lingers at the end of the execution by adding this line just before "End Sub"

On Error Resume Next
ActiveSheet.ShowAllData

Enjoy ^_^
- Reply
To post as a guest, your comment is unpublished.
prdpsharma90@gmail.com · 3 years ago
I have used this VBA code, its split the data but split whole data in new sheet instead of unique value.
- Reply
To post as a guest, your comment is unpublished.
Pradeep Sharma · 3 years ago
The VBA code split the data perfectly but its split the whole data instead of unique value.
- Reply

귀하의 계정에 로그인

비밀번호 재설정