Folks - I'm looking for some code to copy data from worksheet A into
Worksheet B like the following example. This code will fire as part of
another macro. Any help is much appreciated.
Thanks, Mike


Worksheet A
A B C
1 item1 10 20
2 item2 12 19
3 item3 13 89


Worksheet B
A B
1 item1 10
2 item1 20
3 item2 12
4 item2 19
5 item3 13
6 item3 89

Is there ever more than one item1 in col A and are there ever more than 2
other columns? Easier if yes.

--
Don Guillett
Microsoft MVP Excel
SalesAid Software
(E-Mail Removed)
"Mike G - DC" <(E-Mail Removed)> wrote in message
news:F6A5AC3B-E862-44B2-94F1-(E-Mail Removed)...
> Folks - I'm looking for some code to copy data from worksheet A into
> Worksheet B like the following example. This code will fire as part of
> another macro. Any help is much appreciated.
> Thanks, Mike
>
>
> Worksheet A
> A B C
> 1 item1 10 20
> 2 item2 12 19
> 3 item3 13 89
>
>
> Worksheet B
> A B
> 1 item1 10
> 2 item1 20
> 3 item2 12
> 4 item2 19
> 5 item3 13
> 6 item3 89

Hi
Try this.

Sub CopyPaste()
Dim shA As Worksheet
Dim shB As Worksheet
Dim LastRow As Long
Dim r As Long
Dim Item As String

Set shA = Worksheets("Sheet1") 'Change to suit
Set shB = Worksheets("Sheet2") 'Change to suit

LastRow = shA.Range("A1").End(xlDown).Row

For rw = 1 To LastRow
Item = shA.Cells(rw, 1)
r = r + 1
shB.Range("A" & r & ":A" & r + 1) = Item
shB.Cells(r, 2) = shA.Cells(rw, 2)
r = r + 1
shB.Cells(r, 2) = shA.Cells(rw, 3)
Next
End Sub

Regards,
Per

On 5 Aug., 00:00, Mike G - DC <Mike...@discussions.microsoft.com>
wrote:
> Folks - I'm looking for some code to copy data from worksheet A into
> Worksheet B like the following example. This code will fire as part of
> another macro. Any help is much appreciated.
> Thanks, Mike
>
> Worksheet A
> * * *A * * B * *C
> 1 * *item1 * * * * 10 * 20
> 2 * *item2 * * * * 12 * 19
> 3 * *item3 * * * * 13 * 89
>
> Worksheet B
> * * *A * * *B
> 1 * *item1 * * * * *10
> 2 * *item1 * * * * *20
> 3 * *item2 * * * * *12
> 4 * *item2 * * * * *19
> 5 * *item3 * * * * *13
> 6 * *item3 * * * * *89

Hi, just thought the poster may want to see a small modification required to
Per's code:

Sub CopyPaste()
Dim shA As Worksheet
Dim shB As Worksheet
Dim LastRow As Long
Dim r As Long
Dim Item As String

Set shA = Worksheets("Sheet1") 'Change to suit
Set shB = Worksheets("Sheet2") 'Change to suit

LastRow = shA.Range("A1").End(xlDown).Row

For rw = 1 To LastRow
Item = shA.Cells(rw, 1)
r = r + 1
shB.Cells(r, 2) = shA.Cells(rw, 2)
r = r + 1
shB.Cells(r, 2) = shA.Cells(rw, 2) & " " & shA.Cells(rw, 3)
r = r + 1
shB.Cells(r, 2) = shA.Cells(rw, 2) & " " & shA.Cells(rw, 4)
Next

End Sub

HTH,
Ryan---

--
Ryan---
If this information was helpful, please indicate this by clicking ''Yes''.


"Per Jessen" wrote:

> Hi
> Try this.
>
> Sub CopyPaste()
> Dim shA As Worksheet
> Dim shB As Worksheet
> Dim LastRow As Long
> Dim r As Long
> Dim Item As String
>
> Set shA = Worksheets("Sheet1") 'Change to suit
> Set shB = Worksheets("Sheet2") 'Change to suit
>
> LastRow = shA.Range("A1").End(xlDown).Row
>
> For rw = 1 To LastRow
> Item = shA.Cells(rw, 1)
> r = r + 1
> shB.Range("A" & r & ":A" & r + 1) = Item
> shB.Cells(r, 2) = shA.Cells(rw, 2)
> r = r + 1
> shB.Cells(r, 2) = shA.Cells(rw, 3)
> Next
> End Sub
>
> Regards,
> Per
>
> On 5 Aug., 00:00, Mike G - DC <Mike...@discussions.microsoft.com>
> wrote:
> > Folks - I'm looking for some code to copy data from worksheet A into
> > Worksheet B like the following example. This code will fire as part of
> > another macro. Any help is much appreciated.
> > Thanks, Mike
> >
> > Worksheet A
> > A B C
> > 1 item1 10 20
> > 2 item2 12 19
> > 3 item3 13 89
> >
> > Worksheet B
> > A B
> > 1 item1 10
> > 2 item1 20
> > 3 item2 12
> > 4 item2 19
> > 5 item3 13
> > 6 item3 89
>
>

Looks like my example may have adjusted a bit after the fact. Column A will
include an indefinite list of items. Although most will be unique there is a
chance that there may be duplicate item names. My data set actually includes
Data in columns A through O. Column A captures the item and column B through
O capture a numeric count of the item each month. I limited my example
thinking that I could modify the code. Any help is much appreciated.
Thanks, Mike


"Don Guillett" wrote:

> Is there ever more than one item1 in col A and are there ever more than 2
> other columns? Easier if yes.
>
> --
> Don Guillett
> Microsoft MVP Excel
> SalesAid Software
> (E-Mail Removed)
> "Mike G - DC" <(E-Mail Removed)> wrote in message
> news:F6A5AC3B-E862-44B2-94F1-(E-Mail Removed)...
> > Folks - I'm looking for some code to copy data from worksheet A into
> > Worksheet B like the following example. This code will fire as part of
> > another macro. Any help is much appreciated.
> > Thanks, Mike
> >
> >
> > Worksheet A
> > A B C
> > 1 item1 10 20
> > 2 item2 12 19
> > 3 item3 13 89
> >
> >
> > Worksheet B
> > A B
> > 1 item1 10
> > 2 item1 20
> > 3 item2 12
> > 4 item2 19
> > 5 item3 13
> > 6 item3 89
>
>

This should work. Fire from the DESTINATION sheet
Sub remakelist()
Application.ScreenUpdating = False
Sheets("sheet1").Columns("a").Copy Range("a1")
For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
Rows(i - 1).Insert
For j = 2 To Cells(i, Columns.Count).End(xlToLeft).Column
Cells(i, 1).Copy Cells(i - 1, 1)
Cells(i, j).Copy Cells(i - 1, 2)
Next j
Next i
Columns("A:B").Sort Key1:=Range("A1"), Order1:=xlAscending, _
Key2:=Range("B1"), Order2:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Columns("c").Delete
Application.ScreenUpdating = True
End Sub

--
Don Guillett
Microsoft MVP Excel
SalesAid Software
(E-Mail Removed)
"Mike G - DC" <(E-Mail Removed)> wrote in message
news:EDC95C6D-0B8D-4F78-AF71-(E-Mail Removed)...
> Looks like my example may have adjusted a bit after the fact. Column A
> will
> include an indefinite list of items. Although most will be unique there is
> a
> chance that there may be duplicate item names. My data set actually
> includes
> Data in columns A through O. Column A captures the item and column B
> through
> O capture a numeric count of the item each month. I limited my example
> thinking that I could modify the code. Any help is much appreciated.
> Thanks, Mike
>
>
> "Don Guillett" wrote:
>
>> Is there ever more than one item1 in col A and are there ever more than 2
>> other columns? Easier if yes.
>>
>> --
>> Don Guillett
>> Microsoft MVP Excel
>> SalesAid Software
>> (E-Mail Removed)
>> "Mike G - DC" <(E-Mail Removed)> wrote in message
>> news:F6A5AC3B-E862-44B2-94F1-(E-Mail Removed)...
>> > Folks - I'm looking for some code to copy data from worksheet A into
>> > Worksheet B like the following example. This code will fire as part of
>> > another macro. Any help is much appreciated.
>> > Thanks, Mike
>> >
>> >
>> > Worksheet A
>> > A B C
>> > 1 item1 10 20
>> > 2 item2 12 19
>> > 3 item3 13 89
>> >
>> >
>> > Worksheet B
>> > A B
>> > 1 item1 10
>> > 2 item1 20
>> > 3 item2 12
>> > 4 item2 19
>> > 5 item3 13
>> > 6 item3 89
>>
>>

Excellent! Thanks for the help.

"Don Guillett" wrote:

> This should work. Fire from the DESTINATION sheet
> Sub remakelist()
> Application.ScreenUpdating = False
> Sheets("sheet1").Columns("a").Copy Range("a1")
> For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
> Rows(i - 1).Insert
> For j = 2 To Cells(i, Columns.Count).End(xlToLeft).Column
> Cells(i, 1).Copy Cells(i - 1, 1)
> Cells(i, j).Copy Cells(i - 1, 2)
> Next j
> Next i
> Columns("A:B").Sort Key1:=Range("A1"), Order1:=xlAscending, _
> Key2:=Range("B1"), Order2:=xlAscending, Header:=xlGuess, _
> OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
> Columns("c").Delete
> Application.ScreenUpdating = True
> End Sub
>
> --
> Don Guillett
> Microsoft MVP Excel
> SalesAid Software
> (E-Mail Removed)
> "Mike G - DC" <(E-Mail Removed)> wrote in message
> news:EDC95C6D-0B8D-4F78-AF71-(E-Mail Removed)...
> > Looks like my example may have adjusted a bit after the fact. Column A
> > will
> > include an indefinite list of items. Although most will be unique there is
> > a
> > chance that there may be duplicate item names. My data set actually
> > includes
> > Data in columns A through O. Column A captures the item and column B
> > through
> > O capture a numeric count of the item each month. I limited my example
> > thinking that I could modify the code. Any help is much appreciated.
> > Thanks, Mike
> >
> >
> > "Don Guillett" wrote:
> >
> >> Is there ever more than one item1 in col A and are there ever more than 2
> >> other columns? Easier if yes.
> >>
> >> --
> >> Don Guillett
> >> Microsoft MVP Excel
> >> SalesAid Software
> >> (E-Mail Removed)
> >> "Mike G - DC" <(E-Mail Removed)> wrote in message
> >> news:F6A5AC3B-E862-44B2-94F1-(E-Mail Removed)...
> >> > Folks - I'm looking for some code to copy data from worksheet A into
> >> > Worksheet B like the following example. This code will fire as part of
> >> > another macro. Any help is much appreciated.
> >> > Thanks, Mike
> >> >
> >> >
> >> > Worksheet A
> >> > A B C
> >> > 1 item1 10 20
> >> > 2 item2 12 19
> >> > 3 item3 13 89
> >> >
> >> >
> >> > Worksheet B
> >> > A B
> >> > 1 item1 10
> >> > 2 item1 20
> >> > 3 item2 12
> >> > 4 item2 19
> >> > 5 item3 13
> >> > 6 item3 89
> >>
> >>
>
>

This is method works as well. Thanks for the help.

"Per Jessen" wrote:

> Hi
> Try this.
>
> Sub CopyPaste()
> Dim shA As Worksheet
> Dim shB As Worksheet
> Dim LastRow As Long
> Dim r As Long
> Dim Item As String
>
> Set shA = Worksheets("Sheet1") 'Change to suit
> Set shB = Worksheets("Sheet2") 'Change to suit
>
> LastRow = shA.Range("A1").End(xlDown).Row
>
> For rw = 1 To LastRow
> Item = shA.Cells(rw, 1)
> r = r + 1
> shB.Range("A" & r & ":A" & r + 1) = Item
> shB.Cells(r, 2) = shA.Cells(rw, 2)
> r = r + 1
> shB.Cells(r, 2) = shA.Cells(rw, 3)
> Next
> End Sub
>
> Regards,
> Per
>
> On 5 Aug., 00:00, Mike G - DC <Mike...@discussions.microsoft.com>
> wrote:
> > Folks - I'm looking for some code to copy data from worksheet A into
> > Worksheet B like the following example. This code will fire as part of
> > another macro. Any help is much appreciated.
> > Thanks, Mike
> >
> > Worksheet A
> > A B C
> > 1 item1 10 20
> > 2 item2 12 19
> > 3 item3 13 89
> >
> > Worksheet B
> > A B
> > 1 item1 10
> > 2 item1 20
> > 3 item2 12
> > 4 item2 19
> > 5 item3 13
> > 6 item3 89
>
>

If using this you may desire to add the sort to the end of the macro.
'======
..Columns("A:B").Sort Key1:=.Range("A1"), Order1:=xlAscending, _
Key2:=.Range("B1"), Order2:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With

--
Don Guillett
Microsoft MVP Excel
SalesAid Software
(E-Mail Removed)
"Per Jessen" <(E-Mail Removed)> wrote in message
news:655d7f4c-dfaa-4987-b5ad-(E-Mail Removed)...
Hi
Try this.

Sub CopyPaste()
Dim shA As Worksheet
Dim shB As Worksheet
Dim LastRow As Long
Dim r As Long
Dim Item As String

Set shA = Worksheets("Sheet1") 'Change to suit
Set shB = Worksheets("Sheet2") 'Change to suit

LastRow = shA.Range("A1").End(xlDown).Row

For rw = 1 To LastRow
Item = shA.Cells(rw, 1)
r = r + 1
shB.Range("A" & r & ":A" & r + 1) = Item
shB.Cells(r, 2) = shA.Cells(rw, 2)
r = r + 1
shB.Cells(r, 2) = shA.Cells(rw, 3)
Next
End Sub

Regards,
Per

On 5 Aug., 00:00, Mike G - DC <Mike...@discussions.microsoft.com>
wrote:
> Folks - I'm looking for some code to copy data from worksheet A into
> Worksheet B like the following example. This code will fire as part of
> another macro. Any help is much appreciated.
> Thanks, Mike
>
> Worksheet A
> A B C
> 1 item1 10 20
> 2 item2 12 19
> 3 item3 13 89
>
> Worksheet B
> A B
> 1 item1 10
> 2 item1 20
> 3 item2 12
> 4 item2 19
> 5 item3 13
> 6 item3 89