Modification to code to consolidate two sheets...

[Darin Kramer]

Hi There,

The code below neatly consolidates a specific sheet from a workbook
within a sub-directory into a sheet of the book from which the Macro is
run.

I would like to modify it to in addition to selecting column 2 from the
"analysis" sheet, to also select 3 columns from sheet "abc" and paste
into a NEW sheet (ie not the same sheet that existing macro refers too.

(I could just duplicate the macro, changing the sheet name, but then I
would be forced to open all the workbooks twice, so thats why Im trying
to do it all within one Macro...)

Its a complicated one, and thus I appreciate the help even more!!! Any
ideas...?

Regards

Darin

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\user\Desktop\Projects\Projects_06\Consolidation_AR_test_files\*
..xls")
Do While sName <> ""
Set bk = Workbooks.Open("D:\Documents and
Settings\user\Desktop\Projects\Projects_06\Consolidation_AR_test_files\"
& sName)
Call Sheets_Anaylsis_very_visible
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"

 

[Guest]

Sub Consolidator()


Dim i As Long, sName As String, sh As Worksheet
Dim dest As Range, bk As Workbook, bk1 as Workbook
Dim sh1 as Worksheet
Set bk1 = Thisworkbook
i = 1
sName = Dir("D:\Documents and
Settings\user\Desktop\Projects\Projects_06\Consolidation_AR_test_files\*
..xls")
Do While sName <> ""
Set bk = Workbooks.Open("D:\Documents and
Settings\user\Desktop\Projects\Projects_06\Consolidation_AR_test_files\"
& sName)
Call Sheets_Anaylsis_very_visible
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
set sh1 = Bk1.Worksheets.Add(After:=bk1.Worksheets(bk1.worksheets.count))
sh1.name = left(sName,len(sName)-4)
bk.Worksheets("ABC").Range("A1:C1").EntireColumn.copy
sh1.Range("A1:C1").PasteSpecial xlValues
sh1.Range("A1:C1").PasteSpecial xlFormats
' close the workbook

bk.Close SaveChanges:=False
sName = Dir()
Loop
ActiveSheet.Select
ActiveSheet.Name = "Consol"

 

[Darin Kramer]

Thanks Tom... looking good..., but I got a run time error which says
"While renaming a sheet you entered an invalid name"
refers me to line :
sh1.Name = Left(sName, Len(sName) - 4)

Any ideas... ?
(Im not sure that the name of the tab has to be the same as the sheet
which it is opening - ie it can be any name or any sheet, as long as its
not the same as the first sheet..

Kind Regards

Darin

 

[Darin Kramer]

Kinda got it to work by ignoring error line of code, BUT also, I need
the result to be copied to the SAME sheet each time, ie NOT to a new
sheet, ie move one column along and then paste the result, move one
column along and paste the result, etc etc

Regards

Darin

 

[Tom Ogilvy]

Should be easy to modify. Move the add to before the loop

keep track of what column you are copying to. Increment after copying.

 

[Darin Kramer]

Tom,

Im by no means a VB expert, so am struggling a bit - according to me the
add is before the loop already, and I dont know what the syntax is for
an increment...

Im just trying to get the second set all to appear in one sheet...

Appreciate your continued efforts!!!

Regards

Darin