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

"Mike G - DC" wrote in message
...
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
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
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

"Mike G - DC" wrote in message
...
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:o").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:o").Delete
Application.ScreenUpdating = True
End Sub

--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"Mike G - DC" wrote in message
...
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

"Mike G - DC" wrote in message
...
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:o").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:o").Delete
Application.ScreenUpdating = True
End Sub

--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"Mike G - DC" wrote in message
...
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

"Mike G - DC" wrote in message
...
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
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

"Per Jessen" wrote in message
...
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
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