Macro to move data from one sheet to multiple sheet

[sreejeshc]

Hi

I am having a shared file in which multiple users shall input the data in the sheet "Allocate". I need a macro to move the data when they submit the button "Allocate" to the respective sheets based on the criteria selected from the drop down list " Jan 2015" or "Feb 2015" etc. The users can enter the data in any of the rows in the column(B:N) and it can be single row or multi rows.
I have attached the sample file better understanding

[danwagnerco]

Hey @sreejeshc -- good question!

Here's the heavily-commented code that powers an example solution:

Option Explicit
Public Sub MoveDataBasedOnDropDown()
    
    Dim strInput As String, strPromptMessage As String
    Dim wksAllocate As Worksheet, wksTarget As Worksheet
    Dim obj As Object
    Dim lngAllocateLastRow As Long, lngAllocateLastCol As Long, _
        lngTargetLastRow As Long
    Dim rngAllocate As Range, rngTarget As Range
    
    'Set references up-front
    Set wksAllocate = ThisWorkbook.Sheets("Allocate")
    
    'Get the month and year our user has selected
    strInput = wksAllocate.Range("B2").Value
    
    'Verify that the drop-down selection corresponds to an existing sheet
    On Error Resume Next
        Set obj = ThisWorkbook.Sheets(strInput)
        If Err <> 0 Then
            strPromptMessage = "Oops! It appears that your drop-down " & _
                               "selection does not correspond to a " & _
                               "sheet that exists! Create a worksheet " & _
                               "named '" & strInput & "' and try again..."
            MsgBox strPromptMessage
            Exit Sub
        End If
    On Error GoTo 0
    
    'Set the target worksheet now that the selection has been validated
    Set wksTarget = ThisWorkbook.Sheets(strInput)
    
    'Create a range representing the data we will write to the target sheet
    lngAllocateLastRow = LastOccupiedRowNum(wksAllocate)
    lngAllocateLastCol = LastOccupiedColNum(wksAllocate)
    With wksAllocate
        Set rngAllocate = .Range(.Cells(5, 2), _
                                 .Cells(lngAllocateLastRow, lngAllocateLastCol))
    End With
    
    'Create a range representing the destination on the target sheet
    lngTargetLastRow = LastOccupiedRowNum(wksTarget)
    Set rngTarget = wksTarget.Cells(lngTargetLastRow + 1, 1)
    
    'Cut the data from the Allocate sheet and paste to the target sheet
    rngAllocate.Cut Destination:=rngTarget
    
    'Let the user know their input has been allocated!
    MsgBox "Success! Data moved to " & strInput & "!"
    
End Sub


'This function determines the last-occupied row for the passed-in Sheet
Public Function LastOccupiedRowNum(Sheet As Worksheet) As Long
    If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
        With Sheet
            LastOccupiedRowNum = .Cells.Find(What:="*", _
                                             After:=.Range("A1"), _
                                             LookAt:=xlPart, _
                                             LookIn:=xlFormulas, _
                                             SearchOrder:=xlByRows, _
                                             SearchDirection:=xlPrevious).Row
        End With
    Else
        LastOccupiedRowNum = 1
    End If
End Function


'This function determines the last-occupied column for the passed-in Sheet
Public Function LastOccupiedColNum(Sheet As Worksheet) As Long
    If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
        With Sheet
            LastOccupiedColNum = .Cells.Find(What:="*", _
                                             After:=.Range("A1"), _
                                             LookAt:=xlPart, _
                                             LookIn:=xlFormulas, _
                                             SearchOrder:=xlByColumns, _
                                             SearchDirection:=xlPrevious _
                                             ).Column
        End With
    Else
        LastOccupiedColNum = 1
    End If
End Function