Copy past on multiple criteria like dates and center

ramola0911

I have used following code and run successfully.

Expand|Select|Wrap|Line Numbers

 Sub mcopy()
 
a = Worksheets("CRM").Cells(Rows.Count, 1).End(xlUp).Row
 
Dim myModule As String

myModule = Application.InputBox("Enter a Module")
 
For i = 2 To a

    If Worksheets("CRM").Cells(i, 4).Value = myModule Then
 
        Worksheets("CRM").Rows(i).Copy

        Worksheets("MODCRM").Activate

        b = Worksheets("MODCRM").Cells(Rows.Count, 1).End(xlUp).Row
 
        Worksheets("MODCRM").Cells(b + 1, 1).Select

        ActiveSheet.Paste

        Worksheets("CRM").Activate

    End If

Next
 
Application.CutCopyMode = False

'ThisWorkbook.Worksheets("CRM").Cells(1, 1).Select
 
End Sub

I have use input box in the code, but i want to use cell address where i have dropdown list at "CRM" sheet at Cell Addree(D1).

Pl guide me in the matter.

SioSio

Select "View Code" from the right-click menu of the tab of the CRM sheet and write the following code.

Expand|Select|Wrap|Line Numbers

 
Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Range("D1")) Is Nothing Then

        a = Worksheets("CRM").Cells(Rows.Count, 1).End(xlUp).Row

        Dim myModule As String

        myModule = Range("D1").Value

        For i = 2 To a

           If Worksheets("CRM").Cells(i, 4).Value = myModule Then

               Worksheets("CRM").Rows(i).Copy

               Worksheets("MODCRM").Activate

               b = Worksheets("MODCRM").Cells(Rows.Count, 1).End(xlUp).Row

               Worksheets("MODCRM").Cells(b + 1, 1).Select

               ActiveSheet.Paste

               Worksheets("CRM").Activate

            End If

        Next

        Application.CutCopyMode = False

        'ThisWorkbook.Worksheets("CRM").Cells(1, 1).Select

    End If

End Sub

Copy past on multiple criteria like dates and center

Post your reply

Similar topics

Question stats

	Ask Question
Home Questions Articles Browse Topics Latest Top Members FAQ