Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
To extract content fo cells from many workbokks which are identica
Hello,
My VBA below is to extract the information from each individual workbook and cosolidate it But now I want to take just the content of the cells ( formula result) and summarize it in a consolidated workbook. More or less the problem is below: To make it clear, more or less this is the outlay: A B C D 1 2 3 4 5 6 I just want to pull out the content of the cells and I want to make a summary for all: cell to pull out: A1 ( Job Number) A2 ( Proj. Mgr) A6 (Total Budget) D6 ( Total Costs) ...and other cells that I want to pull out the information and summarize it in my sreadsheet to be sideway: Job NO. Proj. Mgr total Budget Total actual........ ---- --------- ------------ ------------- xx xxx xxxx xxx xxx xxxx xxxx xxx The second problem how can I change the getopen that takes file with selection, with get open but we predetermine the workbook to retrieve, since there are a lot of workbooks Below is my macro, which runs ok with copying from workingsheet. Sub FrankS2() Application.ScreenUpdating = False Dim wbCurrent As Workbook, wbConsolidate As Workbook files_to_open = _ Application.GetOpenFilename("Excel files (*.xls), _*.xls", , , , True) If Not IsArray(files_to_open) Then MsgBox "Nothing selected" Exit Sub Else 'Setup new workbook to receive all data Set wbConsolidate = Workbooks.Add For i = LBound(files_to_open) To UBound(files_to_open) Set wbCurrent = Workbooks.Open(files_to_open(i)) Application.StatusBar = "Processing " & files_to_open(i) FrankctoValue3 wbCurrent, wbConsolidate wbCurrent.Close Next i With wbConsolidate.Sheets(1) 'delete top row if A1 blank: If .Range("A1") = "" Then .Range("A1").EntireRow.Delete 'Sort .Cells.Sort Key1:=.Range("A1"), Order1:=xlDescending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal 'adjust column widths .Cells.EntireColumn.AutoFit End With NewFileName = "Consolidated " & Format(Date, "yyyy mmm d") & " at " & Format(Time, "hh mm") wbConsolidate.SaveAs NewFileName wbConsolidate.Close End If Set wbCurrent = Nothing Application.StatusBar = False Application.ScreenUpdating = True MsgBox UBound(files_to_open) - LBound(files_to_open) + _ 1 & " files processed (hopefully), named:" & vbLf & NewFileName End Sub Sub FrankctoValue3(myWb As Workbook, ConsolWb As Workbook) Set ToWs = ConsolWb.Sheets(1) ToWs.Name = "interface" 'adjust name of sheet here Set FromWs = myWb.Worksheets("PO New") HowManyColumnsToCopy = 40 'the number of columns you want copying across 'This section takes all cells in Column AW with a formula, a string or a value in, and processes ONLY those rows 'Range_NonBlanks(Columns("AW")).Select For Each cll In Range_NonBlanks(FromWs.Columns("AW")) 'Union(FromWs.Columns("AW").SpecialCells(xlCellTyp eFormulas, 23), FromWs.Columns("AW").SpecialCells(xlCellTypeConsta nts, 23)) If cll.Value < "" Then Range(cll, cll.Offset(0, HowManyColumnsToCopy - 1)).Copy ToWs.Range("A" & ToWs.Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues End If Next cll 'This section tidies up: deletes top row if empty, sorts, and adjusts column widths 'comment out the next 5 lines to prevent deletion of all but the new sheet Application.DisplayAlerts = False End Sub Thanks for any help. Frank |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Getting "Per Item" Pivot Chart Results when data rows are identica | Excel Discussion (Misc queries) | |||
Compare and match names and extract a cell content | Excel Worksheet Functions | |||
Can I search a cell for a value and extract part of content? | Excel Discussion (Misc queries) | |||
formula to extract partial content (text) of cell | Excel Discussion (Misc queries) | |||
vlookup to extract part cell content | Excel Discussion (Misc queries) |