Macro request: within workbook Copy Row from primary sheet and paste into correlating worksheet

joesalas

joesalas

New Member
Joined
Jun 16, 2005
Messages
27
Hello Wizards,
I'd like to ask your help with creating a macro.
There is one workbook that contains a main worksheet titled "Project List".
The 'Project List' worksheet has data headers or a total of 21 columns. Each row of 'Project List' contains data that must be distributed into multiple worksheets within the same workbook.

The 'Project List' Column A contains the name of the worksheet, where data should be pasted into.

Data Copied from 'Project List' should be pasted into the correlating worksheet starting at B5 and ending in B24.

Worksheet Title Example: Project List

[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD]Worksheet title[/TD]
[TD]b[/TD]
[TD]c[/TD]
[TD]d[/TD]
[TD]e[/TD]
[TD]f[/TD]
[TD]g[/TD]
[TD]h[/TD]
[TD]i[/TD]
[TD]j[/TD]
[TD]k[/TD]
[TD]l[/TD]
[TD]m[/TD]
[TD]n[/TD]
[TD]o[/TD]
[TD]p[/TD]
[TD]q[/TD]
[TD]r[/TD]
[TD]s[/TD]
[TD]t[/TD]
[TD]u[/TD]
[/TR]
[TR]
[TD]car.red[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]plan.blue[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]train.green[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]







Worksheet Title Example: plane.blue



[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD]A1 Title[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]A3 Title[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]A4 Title[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]A5 title From Project List[/TD]
[TD]Start To Paste Data from Project List[/TD]
[/TR]
[TR]
[TD]A6[/TD]
[TD]Paste Data from Project List[/TD]
[/TR]
[TR]
[TD]A7[/TD]
[TD]Paste Data from Project List[/TD]
[/TR]
[TR]
[TD]A8[/TD]
[TD]Paste Data from Project List[/TD]
[/TR]
[TR]
[TD]A9[/TD]
[TD]Paste Data from Project List[/TD]
[/TR]
[TR]
[TD]A10[/TD]
[TD]Paste Data from Project List[/TD]
[/TR]
[TR]
[TD]A11[/TD]
[TD]Paste Data from Project List[/TD]
[/TR]
[TR]
[TD]A12[/TD]
[TD]Paste Data from Project List[/TD]
[/TR]
[TR]
[TD]A13[/TD]
[TD]Paste Data from Project List[/TD]
[/TR]
[TR]
[TD]A14[/TD]
[TD]Paste Data from Project List[/TD]
[/TR]
[TR]
[TD]A15[/TD]
[TD]Paste Data from Project List[/TD]
[/TR]
[TR]
[TD]A16[/TD]
[TD]Paste Data from Project List[/TD]
[/TR]
[TR]
[TD]A17[/TD]
[TD]Paste Data from Project List[/TD]
[/TR]
[TR]
[TD]A18[/TD]
[TD]Paste Data from Project List[/TD]
[/TR]
[TR]
[TD]A19[/TD]
[TD]Paste Data from Project List[/TD]
[/TR]
[TR]
[TD]A20[/TD]
[TD]Paste Data from Project List[/TD]
[/TR]
[TR]
[TD]A21[/TD]
[TD]Paste Data from Project List[/TD]
[/TR]
[TR]
[TD]A22[/TD]
[TD]Paste Data from Project List[/TD]
[/TR]
[TR]
[TD]A23[/TD]
[TD]Paste Data from Project List[/TD]
[/TR]
[TR]
[TD]A24[/TD]
[TD]STOP Paste Data from Project List[/TD]
[/TR]
[TR]
[TD]A25[/TD]
[TD]non related macro data[/TD]
[/TR]
[TR]
[TD]A26[/TD]
[TD]' '[/TD]
[/TR]
[TR]
[TD]A27[/TD]
[TD]' '[/TD]
[/TR]
[TR]
[TD]A28[/TD]
[TD]' '[/TD]
[/TR]
[TR]
[TD]A29[/TD]
[TD]' '[/TD]
[/TR]
[TR]
[TD]A30[/TD]
[TD]' '[/TD]
[/TR]
</tbody>[/TABLE]













































Worksheet Title Example: Car.RED

[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD]A1 Title[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]A3 Title[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]A4 Title[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]A5 title From Project List[/TD]
[TD]Start To Paste Data from Project List[/TD]
[/TR]
[TR]
[TD]A6[/TD]
[TD]Paste Data from Project List[/TD]
[/TR]
[TR]
[TD]A7[/TD]
[TD]Paste Data from Project List[/TD]
[/TR]
[TR]
[TD]A8[/TD]
[TD]Paste Data from Project List[/TD]
[/TR]
[TR]
[TD]A9[/TD]
[TD]Paste Data from Project List[/TD]
[/TR]
[TR]
[TD]A10[/TD]
[TD]Paste Data from Project List[/TD]
[/TR]
[TR]
[TD]A11[/TD]
[TD]Paste Data from Project List[/TD]
[/TR]
[TR]
[TD]A12[/TD]
[TD]Paste Data from Project List[/TD]
[/TR]
[TR]
[TD]A13[/TD]
[TD]Paste Data from Project List[/TD]
[/TR]
[TR]
[TD]A14[/TD]
[TD]Paste Data from Project List[/TD]
[/TR]
[TR]
[TD]A15[/TD]
[TD]Paste Data from Project List[/TD]
[/TR]
[TR]
[TD]A16[/TD]
[TD]Paste Data from Project List[/TD]
[/TR]
[TR]
[TD]A17[/TD]
[TD]Paste Data from Project List[/TD]
[/TR]
[TR]
[TD]A18[/TD]
[TD]Paste Data from Project List[/TD]
[/TR]
[TR]
[TD]A19[/TD]
[TD]Paste Data from Project List[/TD]
[/TR]
[TR]
[TD]A20[/TD]
[TD]Paste Data from Project List[/TD]
[/TR]
[TR]
[TD]A21[/TD]
[TD]Paste Data from Project List[/TD]
[/TR]
[TR]
[TD]A22[/TD]
[TD]Paste Data from Project List[/TD]
[/TR]
[TR]
[TD]A23[/TD]
[TD]Paste Data from Project List[/TD]
[/TR]
[TR]
[TD]A24[/TD]
[TD]STOP Paste Data from Project List[/TD]
[/TR]
[TR]
[TD]A25[/TD]
[TD]non related macro data[/TD]
[/TR]
[TR]
[TD]A26[/TD]
[TD]' '[/TD]
[/TR]
[TR]
[TD]A27[/TD]
[TD]' '[/TD]
[/TR]
[TR]
[TD]A28[/TD]
[TD]' '[/TD]
[/TR]
[TR]
[TD]A29[/TD]
[TD]' '[/TD]
[/TR]
[TR]
[TD]A30[/TD]
[TD]' '[/TD]
[/TR]
</tbody>[/TABLE]
 

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.
Sort by date Sort by votes
Based on the illustration, it is assumed that the data in 'Project List" for each worksheet is horizontal and is to be transposed to vertical when posted to the sheet name specified in column A.
Code: 
Sub copyNpaste()
Dim sh As Worksheet, lr As Long
Set sh = Sheets("Project List")
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
    For Each c In sh.Range("A2:A" & lr)
        Sheets(c.Value).Range("A5") = c.Value
        c.Offset(0, 1).Resize(1, 20).Copy
        Sheets(c.Value).Range("B5").PasteSpecial Paste:=xlPasteAll, Transpose:=True
    Next
Application.CutCopyMode = False
End Sub
 
Upvote 0
Thank you for your assistance, your code was very helpful. The A2 had copied and pasted over some data I needed. Here is a tweak.
Many thanks for your help!
Kind regards

Code: 
Sub CopyNPaste()
    
    Dim ItemCount As Integer
    ItemCount = Application.WorksheetFunction.CountA(ThisWorkbook.Sheets("Project List").Range("A:A")) - 1
    
    If ItemCount = 0 Then
        MsgBox "No items available to transfer."
        Exit Sub
    Else
    End If
    
    Application.ScreenUpdating = False
    Sheets("Project List").Select
    Range("A2").Select
    
    For i = 1 To ItemCount
        Dim mySheet As String
        mySheet = ActiveCell.Value
        ActiveCell.Offset(0, 1).Select
        Sheets(mySheet).Select
        Range("B5").Select
            For x = 1 To 20
                Sheets("Project List").Select
                ActiveCell.Copy
                Sheets(mySheet).Select
                ActiveCell.PasteSpecial xlPasteValues
                ActiveCell.Offset(1, 0).Select
                Sheets("Project List").Select
                ActiveCell.Offset(0, 1).Select
            Next x
        ActiveCell.Offset(1, -21).Select
        'Must end on A3 next cell down, in order to reference next tab name
    Next i
    
    Range("A1").Select
    Application.ScreenUpdating = True
    
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question Question
Create button with update function for already present sheet
Replies
1
Views
650
SeniorNewbie
SeniorNewbie
S
  • Solved
Auto Numbering using "&()&"
Replies
3
Views
206
Fluff
Fluff
B
  • Question Question
How do I get my userform VBA to copy and paste a specific row from a worksheet into another worksheet based on multiple complex conditions?
Replies
1
Views
1K
sijpie
sijpie
alm395
  • Solved
How to see which employees are left off list of projects
Replies
5
Views
380
Fluff
Fluff
C
  • Solved
Unable to copy formula down sheet if data isn't there.
Replies
3
Views
156
Fluff
Fluff

Forum statistics

Threads
1,223,248
Messages
6,171,021
Members
452,374
Latest member
keccles

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top