468,315 Members | 1,472 Online
Bytes | Developer Community
New Post

Home Posts Topics Members FAQ

Post your question to a community of 468,315 developers. It's quick & easy.

Copy past on multiple criteria like dates and center

I have used following code and run successfully.

Expand|Select|Wrap|Line Numbers
  1. Sub mcopy()
  2.  
  3. a = Worksheets("CRM").Cells(Rows.Count, 1).End(xlUp).Row
  4.  
  5. Dim myModule As String
  6. myModule = Application.InputBox("Enter a Module")
  7.  
  8. For i = 2 To a
  9.     If Worksheets("CRM").Cells(i, 4).Value = myModule Then
  10.  
  11.         Worksheets("CRM").Rows(i).Copy
  12.         Worksheets("MODCRM").Activate
  13.         b = Worksheets("MODCRM").Cells(Rows.Count, 1).End(xlUp).Row
  14.  
  15.         Worksheets("MODCRM").Cells(b + 1, 1).Select
  16.         ActiveSheet.Paste
  17.         Worksheets("CRM").Activate
  18.     End If
  19. Next
  20.  
  21. Application.CutCopyMode = False
  22. 'ThisWorkbook.Worksheets("CRM").Cells(1, 1).Select
  23.  
  24. 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.
Sep 9 '18 #1
1 2945
SioSio
241 128KB
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
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2.     If Not Intersect(Target, Range("D1")) Is Nothing Then
  3.         a = Worksheets("CRM").Cells(Rows.Count, 1).End(xlUp).Row
  4.         Dim myModule As String
  5.         myModule = Range("D1").Value
  6.         For i = 2 To a
  7.            If Worksheets("CRM").Cells(i, 4).Value = myModule Then
  8.                Worksheets("CRM").Rows(i).Copy
  9.                Worksheets("MODCRM").Activate
  10.                b = Worksheets("MODCRM").Cells(Rows.Count, 1).End(xlUp).Row
  11.                Worksheets("MODCRM").Cells(b + 1, 1).Select
  12.                ActiveSheet.Paste
  13.                Worksheets("CRM").Activate
  14.             End If
  15.         Next
  16.         Application.CutCopyMode = False
  17.         'ThisWorkbook.Worksheets("CRM").Cells(1, 1).Select
  18.     End If
  19. End Sub
  20.  
Dec 24 '19 #2

Post your reply

Sign in to post your reply or Sign up for a free account.

Similar topics

1 post views Thread by Brendan Wolf | last post: by
reply views Thread by NPC403 | last post: by
By using this site, you agree to our Privacy Policy and Terms of Use.