Hello and thank you in advance for your help. Would this be possible?
I'm trying to create a macro that copies data from one excel worksheet into multiple other worksheet tabs in the same workbook. I have 17 columns and many rows of data. The spreadsheet is sorted by column B. In column B, there are about 10 different values going down throughout the spreadsheet. I would like the data for each of these Column B categories to be copied over to a new tab in the spreadsheet with the tab name as the value in B. So in the end there would be the main tab, and then 10 new tabs with the filtered data. Is that possible?
Thank you very much for your help. - T
This Question has been solved and asker verified All Experts Exchange premium technology solutions are available to subscription members.
Experts Exchange has been collecting answers to technology questions since 1996…3 million and counting! If you have a question, chances are we already have your answer.
If you can't find the exact answer you're looking for, ask our exclusive community of 50,000 experts. You’ll get a personalized answer from a trusted professional.
Thousands of free tech tips, tricks, how-to’s and tutorials are available in our peer reviewed articles section. See for yourself how smart our experts are, no login required.
Save solutions to your questions, answers you’ve discovered through searching plus helpful articles in your personal knowledgebase for easy future access.
Access the answers to your technology questions today.
30-day free trial. Register in 60 seconds.
Members of the expert community talk about why the experience at Experts Exchange is different than what you will find anywhere else.
Try it out and discover for yourself.
30-day free trial. Register in 60 seconds.
Join the community of experts here and help other tech pros by answering question in your area of expertise. You can earn FREE access to all Experts Exchange's premium features and resources.
Hi, this seems a little bit overkill....
Basically, you would iterate through column B of the source sheet, check if that sheet for each cell in Column B exists, and if not, create it, and rename it. If it does exist, just copy the Row to that other sheet.
Is there anything I am missing here, or will that do? if so, I'll re-arrange it for you.
Regards,
Rob.
'heres my 2c worth.... it works fine but im interested to see if there is a better method that does not require the worksheet.activate's.....
Sub CreateTabs()
Dim shtSrc As Worksheet, rngSrc As Range
Dim shtLoop As Worksheet
Dim shtTarget As Worksheet
Dim intRowSrc As Integer
Dim intRowTrgt As Integer
Dim currentdata As String
currentdata = ""
Set shtSrc = ActiveSheet
Set rngSrc = shtSrc.Range("B2") 'set the start cell
Do While Not IsEmpty(rngSrc)
currentdata = rngSrc.Text
'select current row
rngSrc.Rows("1:1").EntireR
Selection.Copy
Set shtTarget = Nothing
On Error Resume Next
Set shtTarget = ActiveWorkbook.Sheets(curr
On Error GoTo 0
'Create and setup sheet if not exist
If shtTarget Is Nothing Then
Set shtTarget = ActiveWorkbook.Sheets.Add(
With shtTarget
.Name = currentdata
.Cells(1, 1) = "Knowledge Category 1"
.Cells(1, 2) = "Knowledge Category 2"
.Cells(1, 3) = "Solution ID"
.Cells(1, 4) = "Solution Summary"
.Cells(2, 1).Select
End With
End If
'Enter new line
With shtTarget
'Find next blank row
intRowTrgt = 1
Do
intRowTrgt = intRowTrgt + 1
Loop Until .Cells(intRowTrgt, 2) = "" 'is test column B
'Enter data
shtTarget.Activate
shtTarget.Cells(intRowTrgt
ActiveSheet.Paste
End With
shtSrc.Activate
Set rngSrc = rngSrc.Offset(1, 0)
Loop
shtSrc.Range("A1").Select
End Sub
Ya, I'm simply looking for a new macro to do the job, or a modification to the one I pasted above. The problem with the one I pasted above is that (a) it creates a new spreadsheet, and (b) it specifies columns to copy when I'd like to copy the entire row and paste in the new spreadsheet based upon what's in column B. Each row has like 30 fields of data so it would be a pain to try to modify the one above since I'd have to specify each individual field in the section:
Cells(1, 1) = "Knowledge Category 1"
.Cells(1, 2) = "Knowledge Category 2"
.Cells(1, 3) = "Solution ID"
.Cells(1, 4) = "Solution Summary"
Is there a simpler query for this?
thanks - T
Hi, guys. I've gone with a slightly different approach here, copying the entire row to the relevant worksheet, based on the value of Column B. I hope this does what you're after. I can explain parts if you're confused by it.
'===============
Sub Collate_Sheets()
' Specify the sheet name of the Source Sheet
strSourceSheet = "Sheet1"
'Get the value from cell B2 to check the code
Set wsSource = ActiveWorkbook.Sheets(strS
For lngRow = 2 To wsSource.Cells(65536, "B").End(xlUp).Row
wsName = wsSource.Cells(lngRow, "B").Value
boolNewWS = True
'Check if the worksheet with the code exists
For Each wsTarget In ActiveWorkbook.Sheets
If LCase(wsTarget.Name) <> LCase(strSourceSheet) And LCase(wsTarget.Name) = LCase(wsName) Then
boolNewWS = False
End If
Next
If boolNewWS = True Then
Set wsTarget = ActiveWorkbook.Sheets.Add(
wsTarget.Name = wsName
wsTarget.Move After:=Sheets(ActiveWorkbo
wsSource.Rows(1).Copy Destination:=wsTarget.Rows
Else
Set wsTarget = ActiveWorkbook.Sheets(wsNa
End If
wsSource.Rows(lngRow).Copy
Next
MsgBox "Done"
End Sub
'===============
Regards,
Rob.
I used RoBSampson's code from above. How would I then go on to do it again for each of the created tabs from the earlier code? In addition, I'd like to create the new subsequent tabs just to the right of the tab from which they came from. Let me know if I should clarify. Any help would be appreciated.
Business Accounts
Answer for Membership
by: tkeifferPosted on 2007-08-18 at 12:43:52ID: 19723568
Actually, I think I can modify this one. However, if there was a way to do it without specifying individual columns then that would be nice. Does this help?
Sub CreateTabs()
Dim wkbNew As Workbook
Dim shtSrc As Worksheet
Dim shtLoop As Worksheet
Dim shtTarget As Worksheet
Dim intRowSrc As Integer
Dim intRowTrgt As Integer
Set shtSrc = ActiveSheet
Set wkbNew = Workbooks.Add()
With wkbNew
'This rowSrc = 5 thing is where it looks for the blank row
intRowSrc = 5
Do While shtSrc.Cells(intRowSrc, 5) <> ""
'Find sheet
Set shtTarget = Nothing
For Each shtLoop In .Sheets
If shtLoop.Name = shtSrc.Cells(intRowSrc, 5) Then
Set shtTarget = shtLoop
Exit For
End If
Next shtLoop
'Create and setup sheet if not exist
If shtTarget Is Nothing Then
Set shtTarget = .Sheets.Add()
With shtTarget
.Name = shtSrc.Cells(intRowSrc, 5)
.Cells(1, 1) = "Knowledge Category 1"
.Cells(1, 2) = "Knowledge Category 2"
.Cells(1, 3) = "Solution ID"
.Cells(1, 4) = "Solution Summary"
.Cells(2, 1).Select
End With
End If
'Enter new line
With shtTarget
'Find next blank row
intRowTrgt = 1
Do
intRowTrgt = intRowTrgt + 1
Loop Until .Cells(intRowTrgt, 1) = ""
'Enter data
.Cells(intRowTrgt, 1) = shtSrc.Cells(intRowSrc, 5)
.Cells(intRowTrgt, 2) = shtSrc.Cells(intRowSrc, 6)
.Cells(intRowTrgt, 3) = shtSrc.Cells(intRowSrc, 16)
.Cells(intRowTrgt, 4) = shtSrc.Cells(intRowSrc, 19)
End With
intRowSrc = intRowSrc + 1
Loop
'Delete Sheets 1 to 3
For Each shtTarget In .Sheets
Select Case shtTarget.Name
Case "Sheet1", "Sheet2", "Sheet3"
shtTarget.Delete
End Select
Next shtTarget
End With