Copy and transpose paste across several worksheets

[Guest]

Hi,

I need a macro that will copy a vertical set of data from one worksheet at a
time across all worksheets except one called "master" and paste that data
horizontally onto the next free row down on the master sheet starting with
row 2.

I also shell of a code that will allow some code I have written to be
applied to one worksheet at a time for all worksheets except one called
"master".

Let me know if you need more information. thanks in advance for any help you
can offer.

John P

 

[james.billy]

Hi,

I need a macro that will copy a vertical set of data from one worksheet at a
time across all worksheets except one called "master" and paste that data
horizontally onto the next free row down on the master sheet starting with
row 2.

I also shell of a code that will allow some code I have written to be
applied to one worksheet at a time for all worksheets except one called
"master".

Let me know if you need more information. thanks in advance for any help you
can offer.

John P

Hi John,

Here is some code (untested!)

dim xSht as worksheet
for each xSht in Sheets
if xSht.Name <> "Master" then
xSht.Range("A1:A50").copy ' <-- The range on each sheet you want
to copy
Sheets("Master").Range("A" & Cells(65536,1).end(xlup).row
+1).pastespecial xlValues, , , True '<-- On Master Sheet In column A
goto Next Available row and transpose Data
endif
next xSht

If you get any problems then let me know,

Regards,

James

 

[Incidental]

Hi

You could try something like this. It will pass the used range in
column A of each sheet in the workbook except the sheet named Master
to an array then on the sheet named Master it will place the elements
of the array in the next available row horizontally . This code is a
little ruff and I'm sure you could probably do it without having to
move between the sheets if you tinker with it a little. I added the
code to a button on a userform but you could rename the sub put it in
a module and run it from the Macro menu or set a keyboard shortcut.

Option Explicit
Dim MyArr
Dim WkSh As Worksheet
Dim FstCell, LstCell, MyCell As Range
Dim i, Cnt, oSet As Integer

Private Sub CommandButton1_Click()

For Each WkSh In Worksheets

If WkSh.Name <> "Master" Then 'Exclude sheet named Master

WkSh.Activate 'Activate sheet

Set FstCell = [A1] 'Set Range

Set LstCell = [A65535].End(xlUp) 'Set Range

MyArr = WkSh.Range(FstCell, LstCell) 'Pass Range to
array

Sheets("Master").Activate 'Go to Master sheet

Cnt = [A65535].End(xlUp).Row 'Find 1st
available row

If Cnt = 1 Then

Set MyCell = [A2]

Else

Set MyCell = [A65535].End(xlUp).Offset(1, 0)

End If

For i = 1 To UBound(MyArr) 'Pass array details to i

oSet = i - 1 'Set offset variable

If i = 1 Then 'If 1st element put in 1st cell

MyCell.Value = MyArr(i, 1)

Else 'Put in the next column

MyCell.Offset(0, oSet) = MyArr(i, 1)

End If

Next i

End If

Next WkSh 'Iterate Worksheet

End Sub

Hope this helps you out

S