Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
new macro
Hi There,
(Please note i have also posted this same question in the Worksheetfunctions newsgroup) I have a macro ('GetMyData' see below for code) that goes through a directory and pulls all relevant details from different excel spreadsheets and copies the data into 1 spreadsheet call 'totalling'. i now wish to try and create a new spreadsheet 'statement' which will collect some info from the spreadsheet called 'totalling' and copy data back into 'statement' i am lost on several points and these are as follows: the field in column 'A' on 'totalling' lists a company name and then fields b etc contain info about 'A' i want to copy cells 'E' 'F' 'G' into 'statement' and do that for as long as 'A' contains that company name. any assitance is greatly appreciated, and i would like to thank you all in advance for any help given. Regards, Scott Sub GetMyData() Application.ScreenUpdating = False Dim objFSO As Scripting.FileSystemObject Dim objFolder As Scripting.Folder Dim objSubfolder As Scripting.Folder Dim objFile As Scripting.File Dim iRow As Long iRow = 3 With ThisWorkbook.Worksheets(1).Range("A1:G1") .Value = Array("Name", "Contact", "Address", "Suburb", "Date", "Number", "Amount") With .Font .Name = "Arial" .Size = 16 .Bold = True End With .HorizontalAlignment = xlCenter End With Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFolder = objFSO.GetFolder("d:\files\spreadsheets\") For Each objFile In objFolder.Files If objFile.Type = "Microsoft Excel Worksheet" Then Workbooks.Open Filename:=objFolder.Path & "\" & objFile.Name With ActiveWorkbook.Worksheets(1) ThisWorkbook.Worksheets(1).Cells(iRow, 1).Value = ..Range("A13").Value ThisWorkbook.Worksheets(1).Cells(iRow, 2).Value = ..Range("A14").Value ThisWorkbook.Worksheets(1).Cells(iRow, 3).Value = ..Range("A16").Value ThisWorkbook.Worksheets(1).Cells(iRow, 4).Value = ..Range("A17").Value ThisWorkbook.Worksheets(1).Cells(iRow, 5).Value = ..Range("F7").Value ThisWorkbook.Worksheets(1).Cells(iRow, 6).Value = ..Range("F8").Value ThisWorkbook.Worksheets(1).Cells(iRow, 7).Value = ..Range("F45").Value End With ActiveWorkbook.Close savechanges:=False iRow = iRow + 1 End If Next ThisWorkbook.Worksheets(1).Cells(iRow + 1, 7) = "=Sum(G2:G" & (iRow - 1) & ")" ThisWorkbook.Worksheets(1).Cells(iRow + 1, 6) = "TOTAL" ThisWorkbook.Worksheets(1).Cells(iRow + 1, 6).Select Selection.Font.Bold = True With Selection.Font .Name = "Arial" .Size = 14 End With ThisWorkbook.Worksheets(1).Cells(iRow + 1, 7).Select Selection.Font.Bold = True With Selection.Font .Name = "Arial" .Size = 14 End With Selection.Style = "Currency" With ThisWorkbook.Worksheets(1).Range("A1:G1").Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With End With ThisWorkbook.Worksheets(1).Columns("A:G").EntireCo lumn.AutoFit Range("A3").Select Range("A3:G68").Sort Key1:=Range("A3"), Order1:=xlAscending, Header:= _ xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal Application.ScreenUpdating = True End Sub |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
new macro
This sounds like your Totalling sheet is a list of invoices for th month. Then what you want to do is collect all invoices for eac company for a monthly statement. An easy way to do this is to use AutoFilter. Try using the macro recorder to do this: Select any cell in your dataset Turn on the recorder. Click Data|Autofilter. In col A select a company Select the entire range Insert a new worksheet Turn off the recorder and look at your new code. If you make a list of all company names, you can add code to your macr like this: Dim oCell as range, x as integer,CompanyName as string x=sheets.count For each oCell in Range("CompanyNameList") CompanyName = oCell.value ....use the code that you recorded.... Copy Destination:= sheet(x).range("A2") x=x+1 next this should get you started ----------------------------------------------- ~~ Message posted from http://www.ExcelTip.com ~~View and post usenet messages directly from http://www.ExcelForum.com |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Macro recorded... tabs & file names changed, macro hangs | Excel Worksheet Functions | |||
Macro Help Needed - Excel 2007 - Print Macro with Auto Sort | Excel Worksheet Functions | |||
My excel macro recorder no longer shows up when recording macro | Excel Discussion (Misc queries) | |||
Macro needed to Paste Values and prevent Macro operation | Excel Discussion (Misc queries) | |||
Start Macro / Stop Macro / Restart Macro | Excel Programming |