Find value and copy row to another sheet

AggyRJ

New Member
Joined
Mar 29, 2013
Messages
16
I have a workbook with 15 different sheets. The one has a compilation of all of the data (Sheet "SM1") and the rest need the data moved to them from SM1 based on values from SM1, column D. Column D is a a four digit numerical value (for instance the first value in cell D4 is 0111). The rest of the sheets are the numerical values (so sheet 2 is named 0111). I need a marco that will search column D in sheet SM1 for a value, and if a cell in the column matches the value then it moves the entire row to the first empty row in another sheet. I am trying to make this as clear as possible so at the risk of possibly being redundant let me give this example. In sheet "SM1" in cell D4 the value is 0111. I need the macro to search column D, find that D4 matches 0111, cuts the entire row that D4 is in, and moves it to the first empty row in sheet 0111. I think that I know enough about macro's to be able to modify it for the other 13 values that I need. Any help would be greatly appreciated. Thank you.
 

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).

sijpie

Well-known Member
Joined
Nov 1, 2008
Messages
3,978
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
This should do the trick.
The sub checks if the sheetnumber exists and then creates sheet if required. Then copies the row accross
If you want to delete the row from the SM1 sheet then add
Code:
rIn.Offset(i, 0).EntireRow.delete
before i=i+1 in the code below

Code:
Option Explicit
'### This sub moves rows to (new) sheets ###
Sub MoveSections()


    Dim rOut As Range, rIn As Range, rInEnd As Range
    Dim i As Long, sSect As String
    Dim wsIn As Worksheet, wsOut As Worksheet
    
    Application.ScreenUpdating = False
    'stop screen flikker
    
    Set wsIn = Sheets("SM1")
    
    Set rIn = wsIn.Cells(4, 4)           '(D4)
    Do While rIn.Offset(i, 0).Value <> vbNullString
        Set wsOut = Nothing
        On Error Resume Next
        Set wsOut = Worksheets(Trim(rIn.Offset(i, 0).Value))
        On Error GoTo 0
        If wsOut Is Nothing Then
            'sheet doesn't exist
            Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = Trim(rIn.Offset(i, 0).Value)
            Set wsOut = ActiveSheet
        End If
        
        Set rOut = wsOut.Cells(wsOut.Rows.Count, "D").End(xlUp).Offset(1, -3)
                'rOut is now set to the first empty row (measured from comun D), column A


                    ' copy the values across. This is done by setting the values _
                      of the range equal, which is way faster than copy paste
            rOut.EntireRow.Value = rIn.Offset(i, 0).EntireRow.Value
        i = i + 1
        
    Loop
    Application.ScreenUpdating = True
    
    Set rIn = Nothing
    Set wsIn = Nothing
    Set rOut = Nothing
    Set wsOut = Nothing
End Sub

Oh yes one more thing: I was assuming that all the rows in SM1 (from 4 down) need to be done.
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,164,395
Messages
5,837,015
Members
430,465
Latest member
Mackbay

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
Top