CODEWITHSUNDEEP
excelvba
SMORF
SMORF

Reputation: 499

Move Row to another worksheet where cell equals worksheet name

I'm quite new to VB. Please come someone advise how I can move a row to another worksheet where a cell value equals the name of another worksheet.

Basically ... in my first worksheet (All Data), I have a range of data populated from an SQL script. In column A there are names of CS Reps that work for our company. Each CS Rep has their own worksheet.

What I need is for VB to check cell A2 (All Data) and move cell range A2:M2 to A2:M2 of the corresponding CS Rep worksheet. The Row from (All Data) should then be deleted.

This process needs to be on a loop until all rows from 'All Data' have moved to the corresponding CS Rep's worksheet. Any mismatches can move to another worksheet named 'Mismatch'. Matched rows should always copy to Row 2 of the corresponding worksheet moving existing data down a row.

I really hope that makes some sense !?!

Thanks SMORF

Sub MoveToCS()

Sheets("All Data").Select
Cells.Select
ActiveWorkbook.Worksheets("All Data").sort.SortFields.Clear
ActiveWorkbook.Worksheets("All Data").sort.SortFields.Add Key:=Range( _
    "A2:A357"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
With ActiveWorkbook.Worksheets("All Data").sort
    .SetRange Range("A1:M357")
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
Cells.Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$M$1000").AutoFilter Field:=1, Criteria1:="ACHAL"
Range("A2:M1000").Select

Selection.Copy
Sheets("ACHAL").Select
Range("A2").Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Sheets("All Data").Select
Selection.EntireRow.Delete
ActiveSheet.Range("$A$1:$M$286").AutoFilter Field:=1

End Sub

Upvotes: 0

Views: 4559

Answers (1)

WltrRpo
WltrRpo

Reputation: 263

i will use the next:

ActiveCell.EntireRow.Insert 'This insert a new row, in the cases ["Matched rows should always copy to Row 2 of the corresponding worksheet moving existing data down a row"]

Activecell.EntireRow.Copy 'This will copy all active row.

ActiveCell.PasteSpecial 'This will paste the data in the clipboard, make sure that this line is after the copy line.

ActiveCell.EntireRow.Delete 'With this you will able to delete the data from the sheet that contains MySQL data source.

According to this, i think that you dont need to order the data, just creat a loop to move for the entire first column of the sheet(All Data), and a switch that evaluates the activecell value and depends of the data select the specific sheet and paste the info, after paste it, go back at the main sheet, delete the activecell and loop, something like this:

Sub Main()
    Sheets("All Data").Activate
    Range("A2").Activate
    Dim SheetToPaste As String
    Do While ActiveCell.Value <> ""
        Select Case ActiveCell.Value
            Case "Hoja2"
                SheetToPaste = "Hoja2"
            Case "Hoja3"
                SheetToPaste = "Hoja3"
            Case Else
                SheetToPaste = "Mismatch"
        End Select
        ActiveCell.EntireRow.Copy
        Sheets(SheetToPaste).Activate
        Range("A2").Activate
        ActiveCell.EntireRow.Insert
        Application.CutCopyMode = False
        Sheets("All Data").Activate
        ActiveCell.EntireRow.Delete
    Loop
End Sub

Hope it works.

Upvotes: 1

Related Questions