Changing code to Consolidate ROWS instead of columns

D

djk

I have code 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
 
T

Tom Ogilvy

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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top