VBA Macro to insert worksheet name and copy it down column

[LuvVBA]

Hi,
The following macro copies two columns from every sheet in the workbook and pastes them into column B and C of the sheet named Journal entry. I would like to add to column A of the Journal entry worksheet the worksheet name for which the columns are being copied. Once I have the worksheet name in column A, I would like to be able to copy that name down up.

In the end I´ll have on the Journal entry worksheet column A populated with a worksheet name on each row and col B and C with its corresponding data. Thank you.

Here is the code I have so far:
Sub WorksheetLoop()
Dim WS_Count As Integer
Dim I As Integer
' Set WS_Count equal to the number of worksheets in the active
' workbook.
WS_Count = ActiveWorkbook.Worksheets.Count
' Begin the loop.
For I = 1 To WS_Count

' Find last empty Row in the Journal Entry worksheet
Dim LastRow As Long
LastRow = Worksheets("Journal Entry").UsedRange.Rows.Count

' Copy Columns G and H from Project tab
Worksheets(I).Range("G11:H150").Copy


' Paste values to Journal Entry tab
Worksheets("Journal Entry").Range("B" & LastRow + 1).PasteSpecial Paste:=xlValues,Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False


' Insert worksheet name in col A of Journal Entry tab
Columns(1).Insert

Cells(2) = Worksheets(I).Name

' Reference a sheet within
' the loop by displaying the worksheet name in a dialog box.
MsgBox ActiveWorkbook.Worksheets(I).Name
Next I
End Sub