Transfering data to a new sheet [Solved/Closed]

Report
-
 Stickihasit -
I'm running excel 2007 on windows 7, if that's important.

I'm trying to find a way to transfer data from a master sheet (or basically sheet 1) to subsequent sheets (2,3,...etc) along with their 3 corresponding columns (data 1, 2, and 3).

My sheets basically look like this:
Title | data1 | data2 | data3
stuff_internal_location_item
stuff_internal_location_item
(more specifically)
stuff_internal_SS_MM
stuff_internal_LS_LKR
stuff_internal_LS_BF

What I'd like to do is be able to find all items with location tag "LS" (the phrase won't be repeated anywhere else in the title) and copy those entries, along with their data to say sheet 2 (which will be designated/titled "LS"). Then I'd like the same thing to happen for "SS" location tags, and so on.

Ideally I don't want to do this by hand, and there will be more and more entries to filter as time goes on(The first page will be updated each month with new information). I've been told a macro can handle this for me, but I'm somewhat new to excel and not entirely sure how to even get this to happen, let alone start recording a macro to do it for me.

Is this something that's even possible, or have I dug myself into a deep hole here?

2 replies

Posts
368
Registration date
Monday February 7, 2011
Status
Contributor
Last seen
September 30, 2013
120
Try This Code:

Sub CopyToNewSheet()

Dim temp, dataWb, resultSh As Worksheet
Dim newWB, supName As String
Dim lastRow, cellNos As Long
Dim i As Integer
    
    Application.DisplayAlerts = False
    
    Set dataWb = ActiveSheet
    Set temp = Worksheets.Add
    
    dataWb.Select
    If dataWb.AutoFilterMode Then
        Cells.Select
        On Error Resume Next
        dataWb.ShowAllData
        On Error GoTo 0
    End If
            
    lastRow = Range("A" & Rows.Count).End(xlUp).Row
    
    dataWb.Range("C1:C" & lastRow).AdvancedFilter Action:=xlFilterCopy, _
    CopyToRange:=temp.Range("a1"), Unique:=True
    'wsCrit.Range("C1:C" & lastRow).AdvancedFilter Action:=xlFilterCopy, _
    CopyToRange:=wsData1.Range("a20"), Unique:=True

        
    cellNos = temp.Range("A" & Rows.Count).End(xlUp).Row
    
    For i = 2 To cellNos
    
        supName = temp.Range("A" & i)
        
        If supName <> "" Then

            Set resultSh = Worksheets.Add
            resultSh.Name = supName
                        
            dataWb.Select
            Cells.Select
            
            If dataWb.AutoFilterMode = False Then
                Selection.AutoFilter
            End If
            
            Selection.AutoFilter Field:=3, Criteria1:="=" & supName, _
                        Operator:=xlAnd, Criteria2:="<>"
            
            lastRow = Range("a" & Rows.Count).End(xlUp).Row
            Rows("1:" & lastRow).Copy
            resultSh.Select
            resultSh.Paste
        End If
    
    Next i
    
    temp.Delete
    
    dataWb.Select
    If dataWb.AutoFilterMode Then
        Cells.Select
        dataWb.ShowAllData
    End If
Application.DisplayAlerts = False
End Sub






1
Thank you

A few words of thanks would be greatly appreciated. Add comment

CCM 2942 users have said thank you to us this month

Here's what I wound up with in the end, for anyone who winds up here via google looking for answers.

Sub Testing_search()
Dim strName As String
Dim wSheet As Worksheet
strName = InputBox(Prompt:="What category would you like to filter for? Options: comsplash, storesplash, launchersplash,igssplash, comsmall, storesmall, launchersmall, igssmall, sidenav.", _
Title:="FILTER SELECTION", Default:="Use lower case please, no spaces(or it will not work).")
If strName = "Use lower case please, no spaces." Or _
strName = vbNullString Then
Exit Sub
Else
Select Case strName
Case "comsplash"
' Com_Splash Macro
' Filters for Com/Home Splash items and copies them to the Com Splash sheet
'Dim wSheet As Worksheet
On Error Resume Next
Set wSheet = Worksheets("Com Splash")
If wSheet Is Nothing Then
' Add-new-sheet code here
Sheets.Add.Name = "Com Splash"
'Copies the header line thing (green stuffz)
Sheets("Store Banners").Select
Range("B2:E2").Select
Selection.Copy
Sheets("Com Splash").Select
Range("A1:D1").Select
ActiveSheet.Paste
Columns("A:A").ColumnWidth = 60
Columns("B:B").ColumnWidth = 10.71
Columns("C:C").ColumnWidth = 10.71
Columns("D:D").ColumnWidth = 10.71
End If
'Finds the correct data and copies it
Sheets("Store Banners").Select
ActiveSheet.Range("A1").AutoFilter Field:=1, Criteria1:= _
"=*comsplash*", Operator:=xlAnd
Range("B3").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("Com Splash").Select
Range("A2").Select
If IsEmpty(Range("A2")) Then
ActiveSheet.Paste
Else
Range("A2").Select
Selection.End(xlDown).Select
Selection.Offset(1, 0).Select
ActiveSheet.Paste
End If
Range("A1:D1048576").Select
Range("A22").Activate
Application.CutCopyMode = False
ActiveSheet.Range("$A$1:$D$1048576").RemoveDuplicates Columns:=1, Header:=xlYes
Sheets("Store Banners").Select
ActiveSheet.Range("A1").AutoFilter Field:=1
Sheets("Com Splash").Select
Range("A1").Select
Case "launchersplash"
' Launcher_Splash Macro
' Copy launcher splash entries to launcher splash sheet
'Dim wSheet As Worksheet
On Error Resume Next
Set wSheet = Worksheets("Launcher Splash")
If wSheet Is Nothing Then
' Add-new-sheet code here
Sheets.Add.Name = "Launcher Splash"
'Copies the header line thing (green stuffz)
Sheets("Store Banners").Select
Range("B2:E2").Select
Selection.Copy
Sheets("Launcher Splash").Select
Range("A1:D1").Select
ActiveSheet.Paste
Columns("A:A").ColumnWidth = 60
Columns("B:B").ColumnWidth = 10.71
Columns("C:C").ColumnWidth = 10.71
Columns("D:D").ColumnWidth = 10.71
End If
'Finds the correct data and copies it
Sheets("Store Banners").Select
ActiveSheet.Range("A1").AutoFilter Field:=1, Criteria1:= _
"=*launchersplash*", Operator:=xlAnd
Range("B3").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("Launcher Splash").Select
Range("A2").Select
If IsEmpty(Range("A2")) Then
ActiveSheet.Paste
Else
Range("A2").Select
Selection.End(xlDown).Select
Selection.Offset(1, 0).Select
ActiveSheet.Paste
End If
Range("A1:D1048576").Select
Range("A22").Activate
Application.CutCopyMode = False
ActiveSheet.Range("$A$1:$D$1048576").RemoveDuplicates Columns:=1, Header:=xlYes
Sheets("Store Banners").Select
ActiveSheet.Range("A1").AutoFilter Field:=1
Sheets("Launcher Splash").Select
Range("A1").Select
Case "storesplash"
'Copies store splash entries into Store Splash sheet
'Dim wSheet As Worksheet
On Error Resume Next
Set wSheet = Worksheets("Store Splash")
If wSheet Is Nothing Then
' Add-new-sheet code here
Sheets.Add.Name = "Store Splash"
'Copies the header line thing (green stuffz)
Sheets("Store Banners").Select
Range("B2:E2").Select
Selection.Copy
Sheets("Store Splash").Select
Range("A1:D1").Select
ActiveSheet.Paste
Columns("A:A").ColumnWidth = 60
Columns("B:B").ColumnWidth = 10.71
Columns("C:C").ColumnWidth = 10.71
Columns("D:D").ColumnWidth = 10.71
End If
'Finds the correct data and copies it
Sheets("Store Banners").Select
ActiveSheet.Range("A1").AutoFilter Field:=1, Criteria1:= _
"=*storesplash*", Operator:=xlAnd
Range("B3").Select
'Selection.End(xlDown).Select
'Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("Store Splash").Select
Range("A2").Select
If IsEmpty(Range("A2")) Then
ActiveSheet.Paste
Else
Range("A2").Select
Selection.End(xlDown).Select
Selection.Offset(1, 0).Select
ActiveSheet.Paste
End If
Range("A1:D1048576").Select
Range("A22").Activate
Application.CutCopyMode = False
ActiveSheet.Range("$A$1:$D$1048576").RemoveDuplicates Columns:=1, Header:=xlYes
Sheets("Store Banners").Select
ActiveSheet.Range("A1").AutoFilter Field:=1
Sheets("Store Splash").Select
Range("A1").Select
Case "igssplash"
'Copies IGS Splash entries to the IGS Splash sheet
'Checks for a sheet named "IGS Splash"; if none exist, creates one.
'Dim wSheet As Worksheet
On Error Resume Next
Set wSheet = Worksheets("IGS Splash")
If wSheet Is Nothing Then
' Add-new-sheet code here
Sheets.Add.Name = "IGS Splash"
'Copies the header line thing (green stuffz)
Sheets("Store Banners").Select
Range("B2:E2").Select
Selection.Copy
Sheets("IGS Splash").Select
Range("A1:D1").Select
ActiveSheet.Paste
Columns("A:A").ColumnWidth = 60
Columns("B:B").ColumnWidth = 10.71
Columns("C:C").ColumnWidth = 10.71
Columns("D:D").ColumnWidth = 10.71
End If
'Finds the correct data and copies it
Sheets("Store Banners").Select
ActiveSheet.Range("A1").AutoFilter Field:=1, Criteria1:= _
"=*igssplash*", Operator:=xlAnd
Range("B3").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
'goes to the corresponding sheet and pastes it
Sheets("IGS Splash").Select
Range("A2").Select
'Checks if sheet is empty or not
If IsEmpty(Range("A2")) Then
ActiveSheet.Paste
Else
Range("A2").Select
Selection.End(xlDown).Select
Selection.Offset(1, 0).Select
ActiveSheet.Paste
End If
Range("A1:D1048576").Select
Range("A22").Activate
Application.CutCopyMode = False
ActiveSheet.Range("$A$1:$D$1048576").RemoveDuplicates Columns:=1, Header:=xlYes
Sheets("Store Banners").Select
ActiveSheet.Range("A1").AutoFilter Field:=1
Sheets("IGS Splash").Select
Range("A1").Select
Case "comsmall"
'Copies Com Small entries to the Com Small sheet
'Checks for a sheet named "Com Small"; if none exist, creates one.
'Dim wSheet As Worksheet
On Error Resume Next
Set wSheet = Worksheets("Com Small")
If wSheet Is Nothing Then
' Add-new-sheet code here
Sheets.Add.Name = "Com Small"
'Copies the header line thing (green stuffz)
Sheets("Store Banners").Select
Range("B2:E2").Select
Selection.Copy
Sheets("Com Small").Select
Range("A1:D1").Select
ActiveSheet.Paste
Columns("A:A").ColumnWidth = 60
Columns("B:B").ColumnWidth = 10.71
Columns("C:C").ColumnWidth = 10.71
Columns("D:D").ColumnWidth = 10.71
End If
'Finds the correct data and copies it
Sheets("Store Banners").Select
ActiveSheet.Range("A1").AutoFilter Field:=1, Criteria1:= _
"=*comsmall*", Operator:=xlAnd
Range("B3").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
'goes to the corresponding sheet and pastes it
Sheets("Com Small").Select
Range("A2").Select
'Checks if sheet is empty or not
If IsEmpty(Range("A2")) Then
ActiveSheet.Paste
Else
Range("A2").Select
Selection.End(xlDown).Select
Selection.Offset(1, 0).Select
ActiveSheet.Paste
End If
Range("A1:D1048576").Select
Range("A22").Activate
Application.CutCopyMode = False
ActiveSheet.Range("$A$1:$D$1048576").RemoveDuplicates Columns:=1, Header:=xlYes
Sheets("Store Banners").Select
ActiveSheet.Range("A1").AutoFilter Field:=1
Sheets("Com Small").Select
Range("A1").Select
Case "storesmall"
'Copies Store Small entries to the Store Small sheet
'Checks for a sheet named "Store Small"; if none exist, creates one.
'Dim wSheet As Worksheet
On Error Resume Next
Set wSheet = Worksheets("Store Small")
If wSheet Is Nothing Then
' Add-new-sheet code here
Sheets.Add.Name = "Store Small"
'Copies the header line thing (green stuffz)
Sheets("Store Banners").Select
Range("B2:E2").Select
Selection.Copy
Sheets("Store Small").Select
Range("A1:D1").Select
ActiveSheet.Paste
Columns("A:A").ColumnWidth = 60
Columns("B:B").ColumnWidth = 10.71
Columns("C:C").ColumnWidth = 10.71
Columns("D:D").ColumnWidth = 10.71
End If
'Finds the correct data and copies it
Sheets("Store Banners").Select
ActiveSheet.Range("A1").AutoFilter Field:=1, Criteria1:= _
"=*storesmall*", Operator:=xlAnd
Range("B3").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
'goes to the corresponding sheet and pastes it
Sheets("Store Small").Select
Range("A2").Select
'Checks if sheet is empty or not
If IsEmpty(Range("A2")) Then
ActiveSheet.Paste
Else
Range("A2").Select
Selection.End(xlDown).Select
Selection.Offset(1, 0).Select
ActiveSheet.Paste
End If
Range("A1:D1048576").Select
Range("A22").Activate
Application.CutCopyMode = False
ActiveSheet.Range("$A$1:$D$1048576").RemoveDuplicates Columns:=1, Header:=xlYes
Sheets("Store Banners").Select
ActiveSheet.Range("A1").AutoFilter Field:=1
Sheets("Store Small").Select
Range("A1").Select
Case "launchersmall"
'Copies Launcher Small entries to the Launcher Small sheet
'Checks for a sheet named "Launcher Small"; if none exist, creates one.
'Dim wSheet As Worksheet
On Error Resume Next
Set wSheet = Worksheets("Launcher Small")
If wSheet Is Nothing Then
' Add-new-sheet code here
Sheets.Add.Name = "Launcher Small"
'Copies the header line thing (green stuffz)
Sheets("Store Banners").Select
Range("B2:E2").Select
Selection.Copy
Sheets("Launcher Small").Select
Range("A1:D1").Select
ActiveSheet.Paste
Columns("A:A").ColumnWidth = 60
Columns("B:B").ColumnWidth = 10.71
Columns("C:C").ColumnWidth = 10.71
Columns("D:D").ColumnWidth = 10.71
End If
'Finds the correct data and copies it
Sheets("Store Banners").Select
ActiveSheet.Range("A1").AutoFilter Field:=1, Criteria1:= _
"=*launchersmall*", Operator:=xlAnd
Range("B3").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
'goes to the corresponding sheet and pastes it
Sheets("Launcher Small").Select
Range("A2").Select
'Checks if sheet is empty or not
If IsEmpty(Range("A2")) Then
ActiveSheet.Paste
Else
Range("A2").Select
Selection.End(xlDown).Select
Selection.Offset(1, 0).Select
ActiveSheet.Paste
End If
Range("A1:D1048576").Select
Range("A22").Activate
Application.CutCopyMode = False
ActiveSheet.Range("$A$1:$D$1048576").RemoveDuplicates Columns:=1, Header:=xlYes
Sheets("Store Banners").Select
ActiveSheet.Range("A1").AutoFilter Field:=1
Sheets("Launcher Small").Select
Range("A1").Select
Case "sidenav"
'Copies Sidenav entries to the Sidenav sheet
'Checks for a sheet named "Sidenav"; if none exist, creates one.
'Dim wSheet As Worksheet
On Error Resume Next
Set wSheet = Worksheets("Sidenav")
If wSheet Is Nothing Then
' Add-new-sheet code here
Sheets.Add.Name = "Sidenav"
'Copies the header line thing (green stuffz)
Sheets("Store Banners").Select
Range("B2:E2").Select
Selection.Copy
Sheets("Sidenav").Select
Range("A1:D1").Select
ActiveSheet.Paste
Columns("A:A").ColumnWidth = 60
Columns("B:B").ColumnWidth = 10.71
Columns("C:C").ColumnWidth = 10.71
Columns("D:D").ColumnWidth = 10.71
End If
'Finds the correct data and copies it
Sheets("Store Banners").Select
ActiveSheet.Range("A1").AutoFilter Field:=1, Criteria1:= _
"=*sidenav*", Operator:=xlAnd
Range("B3").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
'goes to the corresponding sheet and pastes it
Sheets("Sidenav").Select
Range("A2").Select
'Checks if sheet is empty or not
If IsEmpty(Range("A2")) Then
ActiveSheet.Paste
Else
Range("A2").Select
Selection.End(xlDown).Select
Selection.Offset(1, 0).Select
ActiveSheet.Paste
End If
Range("A1:D1048576").Select
Range("A22").Activate
Application.CutCopyMode = False
ActiveSheet.Range("$A$1:$D$1048576").RemoveDuplicates Columns:=1, Header:=xlYes
Sheets("Store Banners").Select
ActiveSheet.Range("A1").AutoFilter Field:=1
Sheets("Sidenav").Select
Range("A1").Select
Case "igssmall"
'Copies IGS Small entries to the IGS Small sheet
'Checks for a sheet named "IGS Small"; if none exist, creates one.
'Dim wSheet As Worksheet
On Error Resume Next
Set wSheet = Worksheets("IGS Small")
If wSheet Is Nothing Then
' Add-new-sheet code here
Sheets.Add.Name = "IGS Small"
'Copies the header line thing (green stuffz)
Sheets("Store Banners").Select
Range("B2:E2").Select
Selection.Copy
Sheets("IGS Small").Select
Range("A1:D1").Select
ActiveSheet.Paste
Columns("A:A").ColumnWidth = 60
Columns("B:B").ColumnWidth = 10.71
Columns("C:C").ColumnWidth = 10.71
Columns("D:D").ColumnWidth = 10.71
End If
'Finds the correct data and copies it
Sheets("Store Banners").Select
ActiveSheet.Range("A1").AutoFilter Field:=1, Criteria1:= _
"=*igssmall*", Operator:=xlOr, Criteria2:="=*igs_*"
Range("B3").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
'goes to the corresponding sheet and pastes it
Sheets("IGS Small").Select
Range("A2").Select
'Checks if sheet is empty or not
If IsEmpty(Range("A2")) Then
ActiveSheet.Paste
Else
Range("A2").Select
Selection.End(xlDown).Select
Selection.Offset(1, 0).Select
ActiveSheet.Paste
End If
Range("A1:D1048576").Select
Range("A22").Activate
Application.CutCopyMode = False
ActiveSheet.Range("$A$1:$D$1048576").RemoveDuplicates Columns:=1, Header:=xlYes
Sheets("Store Banners").Select
ActiveSheet.Range("A1").AutoFilter Field:=1
Sheets("IGS Small").Select
Range("A1").Select
Case Else
'Do other stuff
'Would be cool to have it say "no matches found, try again/okay.
'MsgBox() <--use this?
'Alternatively, pop up a box saying "not an option" and okay it closed or something
MsgBox "Invalid Option, Rerun macro to try again.(* hasn't figured out how to get fancy here yet)" & vbNewLine & vbNewLine & "If you believe you've recieved this message in error, contact *content deleted*"
End Select
End If
End Sub
Oh god, it was formatted in this comment box before I posted it. Sorry =.=