Copying Data Ranges from One Sheet and Pasting in a Different Order

[ph151]

Hi All,

Hoping someone can help me sort out a dilemma I am having moving data from one sheet to another.

I have data placed in Sheet List2 in a set order from A2:D2 and subsequent rows (3, 4 and so on).

I am able to copy the first to to Sheet List to where I want it into a new row, however, the remainder content is not being copied over. Please see the code below:

Sub ExportData()
Dim rng1 As Range, Lst As Long
Dim rng2 As Range, i As Long, cel As Range


    With Sheets("List")
        Set rng2 = .Range("B2,F2,E2,H2")
        Lst = .Range("B" & Rows.Count).End(xlUp).Row
    End With
 
    For Each cel In rng2
        cel(Lst).Value = Sheets("List2").Range(Array("A2", "B2", "C2", "D2")(i))
        i = i + 1
    Next
End Sub

SOURCE DATA (SHEET(LIST2))

	A	B	C	D
1	RISK	IMPACT	WBS	STATUS
2	RISK 1	MILD	1.2.2	OPEN
3	RISK 2	SEVERE	1.1.2	NEW
4	RISK 3	MILD	2.1	NEW
5

<tbody>
</tbody>

CURRENT EXPORTED DATA (SHEET(LIST))

	A	B	C	D	E	F	G	H
1	SER	RISK	....	....	WBS	IMPACT	....	STATUS
2	....	RISK 1	....	....	1.2.2	MILD	....	OPEN
3	....	RISK 1	....	....	1.2.2	MILD	....	OPEN
4	....	RISK 1	....	....	1.2.2	MILD	....	OPEN
5

<tbody>
</tbody>

REQUIRED EXPORTED DATA (SHEET(LIST))

	A	B	C	D	E	F	G	H
1	SER	RISK	....	....	WBS	IMPACT	....	STATUS
2	....	RISK 1	....	....	1.2.2	MILD	....	OPEN
3	....	RISK 2	....	....	1.1.2	SEVERE	....	NEW
4	....	RISK 3	....	....	2.1	MILD	....	NEW
5

<tbody>
</tbody>

And once the data has been written to the Sheet LIST, any changes to Sheet LIST2 will be written to a new line on Sheet LIST.

I know a big ask, but any help is much appreciated.

Many thanks,

P

 

[footoo]

Try this (untested) :

Sub ExportData()
Dim rng As Range, cel As Range
With Sheets("List2")
    Set rng = .Range(.[A2], .Cells(Rows.Count, "A").End(xlUp))
End With
Set cel = Sheets("List").Cells(Rows.Count, "B").End(xlUp)(2)
With rng
    .Copy cel
    .Offset(0, 1).Copy cel(1, 5)
    .Offset(0, 2).Copy cel(1, 4)
    .Offset(0, 3).Copy cel(1, 7)
End With
End Sub

 

[ph151]

Hi Footoo,

Many thanks for this. Now tested and works a treat.

Cheers for your help.

Rgds

P