Create a Cost tracking worksheet from two different Worksheet within the same Workbook

[chamdan]

Help needed,

I have a worksheet that contains WBS Work Breakdown Structure, and a worksheet within the same Workbook that contains Cost center, my

objective is to create a Cost tracking WBS Project Budget that will be created automatically by inserting each of the WBS and Task Name and

insert underneath each of these WBS the following cost center as described below. This is to make the process be automated no matter what new project comes along.

1    Phase 1
1.1    Sub 1
1.1.1        Task 1-1
1.1.2        Task 2-1
1.1.3        Task 3-1
1.1.4        Task 4-1
1.2    Sub 2-1
1.2.1        Task 1-2
1.2.2        Task 2-2
1.2.3        Task 3-2
2    Phase 2
2.1    Sub 1-2
2.1.1        Task A
2.1.2        Task B
2.1.3        Task C

1    Phase 1
    9100    Labor a/c
    9200    Non-Labor a/c
    9300    Travel a/c
    9400    Materials a/c
    9500    Stationary a/c
    9600    Telephone a/c
    9700    Other a/c
1.1    Sub 1
    9100    Labor a/c
    9200    Non-Labor a/c
    9300    Travel a/c
    9400    Materials a/c
    9500    Stationary a/c
    9600    Telephone a/c
    9700    Other a/c
1.1.1        Task 1-1
    9100    Labor a/c
    9200    Non-Labor a/c
    9300    Travel a/c
    9400    Materials a/c
    9500    Stationary a/c
    9600    Telephone a/c
    9700    Other a/c

Can someone help me achieve this? Thanks in advance.

 

[chamdan]

For those in need of how to resolve such request, well! here is the solution below, which has been given to me from the Microsoft forum site:

Sub WBSFillout()
Set s1 = Sheets("Sheet1")
Set s2 = Sheets("Sheet2")
Set s3 = Sheets("Sheet3")
n1 = s1.Cells(Rows.Count, "A").End(xlUp).Row
Set r1 = s1.Range("A1:A" & n1)
Set r2 = s2.Range("A1:A7")
n3 = 1
For Each rr1 In r1
    rr1.Copy s3.Cells(n3, "A")
    n3 = n3 + 1
    r2.Copy s3.Cells(n3, "A")
    n3 = s3.Cells(Rows.Count, "A").End(xlUp).Row + 1
Next
End Sub

 

[chamdan]

A slight correction has been brought to the macro to works smoothly and get all the information as expected. Here below is the macro:

Sub WBSFillout()
Set s1 = Sheets("Sheet1")
Set s2 = Sheets("Sheet2")
Set s3 = Sheets("Sheet3")
n1 = s1.Cells(Rows.Count, "A").End(xlUp).Row
Set r1 = s1.Range("A1:A" & n1)
Set r2 = s2.Range("A1:B7")
n3 = 1
For Each rr1 In r1
  Union(rr1, rr1.Offset(0, 1)).Copy s3.Cells(n3, "A")
  n3 = n3 + 1
  r2.Copy s3.Cells(n3, "A")
  n3 = s3.Cells(Rows.Count, "A").End(xlUp).Row + 1
Next
End Sub