Vba for copy and paste with specific criteria

[SWETHAKHATRI88]

Hi. My excel sheet looks like this with 100 projects. What I would like to do it
1. Search for Project code 1415
2. Copy all the rows from A21-A29 and paste it in Sheet 2
3. Next search for code 1414
4. Copy all the rows from A9-A20 and paste it in the next available row in Sheet 2
5. Next Search for code 1416
6. Copy all the rows from A30-A36( A 36 is end of range) and paste it in next available row in Sheet 2

Can you please advise how this can be done. Data set for reference below

The code I have tried till now is
Sub Test()
Columns("B:B").Select
Selection.Find(What:="1415", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate

x = ActiveCell.Row

 

[DanteAmor]

Hi and welcome to MrExcel!

Try this:

Sub copyprojects()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim arr As Variant, itm As Variant
  Dim nextr As Long, n As Long
  Dim f As Range
  
  Application.ScreenUpdating = False
  
  Set sh1 = Sheets("Sheet1")            'source
  Set sh2 = Sheets("Sheet2")            'destination
  
  arr = Array("1415", "1414", "1416")   'project codes
  
  sh2.Cells.ClearContents
  n = 2
  For Each itm In arr
    Set f = sh1.Range("B:B").Find(itm, , xlValues, xlWhole, , , False)
    If Not f Is Nothing Then
      nextr = f.Offset(3).End(xlDown).Row - 1
      If nextr > 1000000 Then nextr = f.Row + 100
      sh1.Rows(f.Row & ":" & nextr).Copy sh2.Range("A" & n)
      n = n + nextr - f.Row + 1
    End If
  Next

  Application.ScreenUpdating = False
End Sub

Some tips:

----------------
NOTE XL2BB:
For the future, it would help greatly if you could give us the sample data in a form that we can copy to test with, rather that a picture.
MrExcel has a tool called “XL2BB” that lets you post samples of your data that will allow us to copy/paste it to our Excel spreadsheets, so we can work with the same copy of data that you are. Instructions on using this tool can be found here: XL2BB Add-in
Note that there is also a "Test Here” forum on this board. This is a place where you can test using this tool (or any other posting techniques that you want to test) before trying to use those tools in your actual posts.
Ex:

Dante Amor
	A	B	C
1	PROJECT CODE	1413
2	PROJECT MGR	ANCD
3	TEST NAME	TEST
4
5
6
7
8
9	PROJECT CODE	1414
10	PROJECT MGR	BNGD
11	TEST NAME	TEST
12
13
14
15
16
17
18
19
20
21	PROJECT CODE	1415
22	PROJECT MGR	AMELIA
23	TEST NAME	TEST
24
25
26
27
28
29
30	PROJECT CODE	1416
31	PROJECT MGR	NAT
32	TEST NAME	TEST
33
34
35
36
Sheet1

------------------
Note Code Tag:
In future please use code tags when posting code.
How to Post Your VBA Code it makes your code easier to read and copy and it also maintains VBA formatting.

 

[SWETHAKHATRI88]

Thank you for the code. It works perfectly fine

 

[DanteAmor]

Im glad to help you. Thanks for the feedback.