Consolidating ROWS instead of columns HELP PLSE...:)

[Darin Kramer]

Hi,

Im desparately trying to find a solution to the below problem - any help
to a limited VB user such as myself will be most welcome!!!

I have relatively simple code (thanks to Tom) below which neatly
consolidates columns from a worksheet into a master worksheet.
(it opens each workbook within a folder, selects the applicable
sheet(Analysis), and copies the applicable columns into the book from
which the macro is run, then repeats the process ie opening the next
workbook copying columns from the applicable sheet, pasting in the book
from which the macro is run in the same sheet in the next free column,
and so on)

All Im wanting to do is to instead of make it take columns, make it take
rows ....
(ideally the last row with text in it, or if finding the last row is too
difficult, then it could be the range a1:ae300)

If you can help, it would be MOST MOST appreciated!!!

Regards

Darin

Code is:

Sub Consolidator

Dim i As Long, sName As String, sh As Worksheet Dim dest As Range, bk As
Workbook i = 1 sName = Dir("D:\Documents and
Settings\dk\Desktop\Consolidation_AR_test_files\*.xls")
Do While sName <> ""
Set bk = Workbooks.Open("D:\Documents and
Settings\dk\Desktop\Consolidation_AR_test_files\" & sName) Set sh =
bk.Worksheets("Analysis") Set dest = ThisWorkbook.Worksheets(1).Cells(1,
i)
i = i + 1
sh.Columns(3).Copy
dest.PasteSpecial xlValues
dest.PasteSpecial xlFormats
' write name of the workbook in row 1
dest.Value = sName
' close the workbook
bk.Close SaveChanges:=False
sName = Dir()
Loop
ActiveSheet.Select
ActiveSheet.Name = "Consol_AR_summary"

end sub

 

[Guest]

Sure:

First replace:
Set dest = ThisWorkbook.Worksheets(1).Cells(1, i)
with
Set dest = ThisWorkbook.Worksheets(1).Cells(i, 1)


Then replace:
sh.Columns(3).Copy
with
sh.Rows(3).Copy


To transfer the third row rather than the third column.

 

[Darin Kramer]

Thanks Gary!!! but I need multiple rows - so rows 1 to 300 need to
be selected....

Regards

Darin

 

[Guest]

Sub ConsolidatRows()

Dim sName As String
Dim sh As Worksheet , sPath as String
Dim dest As Range, bk As Workbook
Dim rng as Range

sPath = "D:\Documents and Settings\dk" _
"\Desktop\Consolidation_AR_test_files\"
sName = Dir(sPath & "*.xls")
Do While sName <> ""
Set bk = Workbooks.Open(sPath & sName)
Set sh = bk.Worksheets("Analysis")
Set dest = ThisWorkbook.Worksheets(1).Cells(rows.count,1).end(xlup)(2)
set rng = sh.Range(sh.Cells(1,1),sh.Cells(rows.count,1).End(xlup))
rng.EntireRow.copy
dest.PasteSpecial xlValues
dest.PasteSpecial xlFormats

bk.Close SaveChanges:=False
sName = Dir()
Loop
ActiveSheet.Select
ThisWorkbook.Worksheets(1).Name = "Consol_AR_summary"

end sub