Copy heading and name to applicable sheet

[howard]

I have names in Col O in Sheet2


I need the header in (O1) as well as the name in Col O to be copied to Z1 on the applicable sheet for eg BR1 on Col O as well as the heading to be copied to Sheet BR1 Z1.


it would be appreciated if someone could kindly provide me with code to do this

Book1
	O
1	Branch Name
2	BR1
3	BR2
4	BR3
5	BR4
6	BR5
7	BR6
8	BR7
9	BR8
10	BR9
11	BR10
12	BR11
13	BR12
Sheet2

 

[howard]

Thanks for your amended code. I only want the email adresses copied into AA1 onwards. The code is inserting the sheet name before the email address in AA1

See link showing result after running the macro

https://app.box.com/s/0no5a4rpq7fsnin4md889keivel86y6a


Kindly amend

 

[mumps]

Try:

Sub CopyCells2()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim x As Long, rng As Range
    For x = 2 To LastRow Step 7
        Range("W" & x).Resize(3).Copy Sheets(Range("W" & x - 1).Value).Range("AA1")
    Next x
    Application.ScreenUpdating = True
End Sub

 

[howard]

Thanks very much for your help, code works perfectly

 

[howard]

I tried to amend your code to include the items in Col V as well which has the names extracted from the email address, but it is not cpying this to the relevant sheets

https://app.box.com/s/nmh88tv58m36ywvo689qtwho1pcgcf70



Kindly test & amend code

 

[mumps]

Do you want the values of column V pasted into column Y of the relevant sheets or added to column Z? If added, do you want them at the beginning or end in column Z?

 

[howard]

Thanks for the reply. I need values in column V pasted into column Y of the relevant sheets

 

[mumps]

Try:

Sub CopyCells2()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim x As Long, rng As Range
    For x = 2 To LastRow Step 7
        Range("V" & x).Resize(3).Copy Sheets(Cells(x - 1, "W").Value).Range("Y1")
        Range("W" & x).Resize(3).Copy Sheets(Range("W" & x - 1).Value).Range("Z1")
    Next x
    Application.ScreenUpdating = True
End Sub

 

[howard]

Thanks for the help. Much appreciated

 

[mumps]

My pleasure.

 

[howard]

I have another sample file where I need to copy the items in Col V & W to the relevant sheet for eg all the items for BR1 that are 3 rows below it to be copied to sheet BR1 in Col Y1 & Z1, all the items for BR3 that are 3 rows below it to be copied to sheet BR2 in Col Y1 & Z1 etc


I have attached a sample file on Box




https://app.box.com/s/nmh88tv58m36ywvo689qtwho1pcgcf70

 Sub CopyCells2()
Sheets(1).Select

    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim x As Long, rng As Range
    For x = 2 To LastRow Step 5
        Range("V" & x).Resize(1).Copy Sheets(Cells(x - 1, "w").Value).Range("Y1")
        Range("W" & x).Resize(1).Copy Sheets(Range("W" & x - 1).Value).Range("Z1")
    Next x
    Application.ScreenUpdating = True
End Sub

Kindly test & amend the code