Results 1 to 2 of 2

Thread: Macro to move data from one sheet to multiple sheet

  1. #1

    Macro to move data from one sheet to multiple sheet

    Register for a FREE account, and/
    or Log in to avoid these ads!


    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

    Attached Files Attached Files

  2. #2
    Acolyte danwagnerco's Avatar
    Join Date
    Sep 2015
    Chicago, IL, USA
    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, _
            End With
            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 _
            End With
            LastOccupiedColNum = 1
        End If
    End Function

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts