Saturday, April 20, 2019

Copy data from another sheet to your sheet within same workbook

Sub SimpleMacro()

'You can use the below statement to Copy and Paste the Data
'Sheets(Your Source Sheet).Rows(Your Source Range).Copy Destination:=Sheets(Your Target Sheet).Range(Your Target Range)
'For Example:

Sheets("SourceSheet").Range("B4:B5").Copy Destination:=Sheets("TargetSheet").Range("C2")

End Sub


Sub CopyDataBasedOnStatusCondtion()
'You can also copy entire row and paste into different sheets based on certain criteria.
'See the below example to copy the rows based on criteria


Dim lRow, cRow As Long
lRow = Sheets("YourMain").Range("A50000").End(xlUp).Row 'Last row in your main sheet
'change the sheet name as per your needs


'Let's find these items in the Main sheet and send to the respective sheet
For j = lRow To 1 Step -1
'Assuming you have the drop-down in the first Column (= Column A)
 
'looping throu your main sheet and copying the data into respective sheet
    If Sheets("YourMain").Range("A" & j) = "Pending" Then
        cRow = Sheets("Pending").Range("A50000").End(xlUp).Row
        Sheets("YourMain").Rows(j).Copy Destination:=Sheets("Pending").Range("A" & cRow + 1)
     
        'You can delete the copied rows in the source sheet using below statement
        'Sheets("YourMain").Rows(j).Delete
    ElseIf Sheets("YourMain").Range("A" & j) = "Follow up" Then
        cRow = Sheets("Follow up").Range("A50000").End(xlUp).Row
        Sheets("YourMain").Rows(j).Copy Destination:=Sheets("Follow up").Range("A" & cRow + 1)
     
        'Sheets("YourMain").Rows(j).Delete
 
    ElseIf Sheets("YourMain").Range("A" & j) = "Completed" Then
        cRow = Sheets("Completed").Range("A50000").End(xlUp).Row
        Sheets("YourMain").Rows(j).Copy Destination:=Sheets("Completed").Range("A" & cRow + 1)
     
        'Sheets("YourMain").Rows(j).Delete
    End If
Next


'*NOTE:if this solution is for your clients, -
'You may have to write some validation steps-
'to check if all required sheets are available in the workbook
'to avoid future isssue.
End Sub



No comments:

Post a Comment