Excel Macro to Copy & Paste

[prometheus_au]

G'day Guys,

I have a few hundred workbooks in a folder (each containing only a
single sheet) which contain information in the cell range F12:G40

What I'm trying to acheive is to consolidate the data onto a single
sheet (in a new workbook)and seperate the data onto individual rows on
the resulting sheet.

For example:
F12 would be copied to A2, F13 to A3, G13 to A4, F14 to A5, G14 to A6,
F15 to A7, G15 to A8.... and so on. With A1 on the new sheet taking the
name of the sheet with the data. Once the data is on a single line,
closing the sheet opening the next sheet in the folder and doing the
same with Row B, next sheet on Row C and so on.

So From this:

Sheet1 Sheet2


Data F12 Data F12
Data F13 Data G13 Data F13 Data G13
Data F14 Data G14 Data F14 Data G14
Data F15 Data G15 Data F15 Data G15
Data F16 Data G16 Data F16 Data G16
Data F17 Data G17 Data F17 Data G17
Data F18 Data G18 Data F18 Data G18

To This:

Resulting Sheet

Sheet1 Data F12 Data F13 Data G13 Data F14 Data G14 Data F15
Data G15 Data F16 Data G16...... etc....
Sheet2 Data F12 Data F13 Data G13 Data F14 Data G14 Data F15
Data G15 Data F16 Data G16...... etc....
Sheet3 Data F12 Data F13 Data G13 Data F14 Data G14 Data F15
Data G15 Data F16 Data G16...... etc....




What I have so far to work with is this....


Sub ACollectall()
On Error GoTo Exit_Line
Application.ScreenUpdating = False
Application.EnableEvents = False

Dim wbkTempBook As Workbook
Dim shtPasteSheet As Worksheet, shtTemp As Worksheet
Dim lngMaxRow As Long, lngCopyRows As Long, lngPasteRow As Long,
lngIgnoreRows As Long

lngPasteRow = 1 'Row to start copying to
lngIgnoreRows = 11 'Number of Rows to ignore

Set shtPasteSheet = ThisWorkbook.Sheets(1)

sFolderPath = "C:\Desktop\Data\"

sTempName = Dir(sFolderPath & "*.*")
Do While sTempName <> ""
Set wbkTempBook = Workbooks.Open(sFolderPath & "\" & sTempName,
True, True)
Set shtTemp = wbkTempBook.Sheets(1)
wbkTempBook.Sheets(1).Range("F12:G40") = wbkTempBook.Sheets(1).Name
lngMaxRow = 110
lngCopyRows = lngMaxRow - lngIgnoreRows
If lngMaxRow > lngIgnoreRows Then
shtTemp.Range("A" & lngIgnoreRows + 1 & ":V" & lngMaxRow).Copy
_
shtPasteSheet.Range("A" & lngPasteRow & ":V" & lngPasteRow
+ lngCopyRows - 1)
lngPasteRow = lngPasteRow + lngCopyRows
End If
wbkTempBook.Close (False)
sTempName = Dir
Loop

What this does is copy the data as a block, move onto the next empty
cell, open the next sheet and repeat the process. Is there a way of
taking the data from the multidude of sheets I have and placing it on a
resulting sheet Row by Row?


Any help would be appreciated!

Cheers