VBA - copy multiple column data in to a list

rashid67

New Member
Joined
Oct 22, 2013
Messages
14
I need a vba code to copy multiple columns from sheet1 and paste as list in sheet2

Here is current data format in sheet1

HG H I J KL M
16001/2018002/2018003/2018
17800090009500
18LondonNewYorkParis
19 GL acctName Plan Actual Plan Actual Plan Actual
20 1000Salary500450500400500390
21 1001Travel150135150120150117
22 1002Meal504550405039

<tbody>
</tbody>


New format in sheet2 -list

DateSite noSiteGL acctNamePlanActual
001/20188000London1000Salary500450
001/20188000London1001Travel150135
001/20188000London1002Meal5045
002/20189000NewYork1000Salary500400
002/20189000NewYork1001Travel150120
002/20189000NewYork1002Meal5040
003/20189500Paris1000Salary500390
003/20189500Paris1001Travel150117
003/20189500Paris1002Meal5039

<tbody>
</tbody>
 

footoo

Well-known Member
Joined
Sep 21, 2016
Messages
2,746
Are the data in rows 16:17 in columns H, J, L ; or in columns G,I,K and centered or merged?
 

rashid67

New Member
Joined
Oct 22, 2013
Messages
14
data in row 16:18 starts from column I and it is not merged or centered

data in row 20:22 starts from column G

Thanks.
 

footoo

Well-known Member
Joined
Sep 21, 2016
Messages
2,746
data in row 16:18 starts from column I and it is not merged or centered

data in row 20:22 starts from column G

Thanks.
That doesn't match what you posted.

Are the columns like this :
Col F - GL acct
Col G - Name
Col H - Plan
Col I - Actual
Col J - Plan
Col K - Actual
Col L - Plan
Col M - Actual

Or like this :
Col G - GL acct
Col H - Name
Col I - Plan
Col J - Actual
Col K - Plan
Col L - Actual
Col M - Plan
Col N - Actual
 

rashid67

New Member
Joined
Oct 22, 2013
Messages
14
its like this

ol G - GL acct
Col H - Name
Col I - Plan
Col J - Actual
Col K - Plan
Col L - Actual
Col M - Plan
Col N - Actual
 

rashid67

New Member
Joined
Oct 22, 2013
Messages
14
its like this

Col G - GL acct

Col H - Name
Col I - Plan
Col J - Actual
Col K - Plan
Col L - Actual
Col M - Plan
Col N - Actual
 

footoo

Well-known Member
Joined
Sep 21, 2016
Messages
2,746
Code:
Sub FT()
Dim rng As Range, c%
Application.ScreenUpdating = False
ActiveSheet.Copy After:=ActiveSheet
[A:C].Delete
[A:C].ClearContents
[A19] = "Date"
[B19] = "Site no"
[C19] = "Site"
Set rng = Range([F16], Cells(16, Columns.Count).End(xlToLeft))
For c = 1 To rng.Columns.Count Step 3
    rng(1, c).Resize(3).Copy
    Cells(Rows.Count, "A").End(xlUp)(2).Resize(3, 3).PasteSpecial Paste:=xlPasteAll, Transpose:=True
Next
Set rng = Range([H20], Cells(20, Columns.Count).End(xlToLeft))
For c = 1 To rng.Columns.Count Step 3
    rng(1, c).Resize(3, 3).Copy Cells(Rows.Count, "E").End(xlUp)(2)
Next
Rows("1:18").Delete
rng.EntireColumn.Delete
[D2:D4].Copy Range([D5], Cells(Rows.Count, "C").End(xlUp)(1, 2))
[A:C].EntireColumn.AutoFit
End Sub
 

Forum statistics

Threads
1,085,913
Messages
5,386,751
Members
402,017
Latest member
ShandaD

Some videos you may like

This Week's Hot Topics

Top