By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
459,405 Members | 1,357 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 459,405 IT Pros & Developers. It's quick & easy.

Copy past on multiple criteria like dates and center

P: 1
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
Share this Question
Share on Google+
1 Reply


100+
P: 150
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.