How To Split Data Into Multiple Worksheets By Rows Count In Excel VBA?

Rakesh Kamani

New Member
Joined
Feb 25, 2020
Messages
33
Office Version
  1. 2013
Platform
  1. Windows
Group_NamesDept_nameTitleScore
Testing_01Jan12
aaWDNnhf58
bbNLDkiuj48
Testing_02
aaaUGTjyu47
bbbKLJbv55
cccIKUgt5
Testing_03
aaaaLIKrt87
bbbbBGFrt96
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.
Group_NamesDept_nameTitleScore
Testing_01Jan12
aaWDNnhf58
bbNLDkiuj48
Testing_02
aaaUGTjyu47
bbbKLJbv55
cccIKUgt5
Testing_03
aaaaLIKrt87
bbbbBGFrt96
I want split group_name into multiple sheet in same workbook, like (Testing_01,Testing_02,Testing_03)
worksheet: Testing_01
Group_NamesDept_nameTitleScore
aaWDNnhf58
bbNLDkiuj48
 
Upvote 0
When I Ran this below code All rows values split in to different sheet, I didn't understand where i done mistake. please modify this and provide correct solution.
Thank for advance.
Private Sub CommandButton1_Click()

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:D1"
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
 
Upvote 0

Forum statistics

Threads
1,223,911
Messages
6,175,337
Members
452,637
Latest member
Ezio2866

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top