Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copying data from several spreadsheets into a new spreadsheet
Hi,
I'm pretty much a novice at Excel macros so forgive me if I don't understand your responses the first time. I want to write a macro that will open a variable number of spreadsheets in a specific folder and copy a range of a variable number of rows from each spreadsheet into a single new spreadsheet with each range being copied immediately below the previous range. Each originating spreadsheet name will start with the date (e.g. 2009-03-31 Rest of spreadsheet name.xls) so I want the macro to open all spreadsheets in the folder starting with '2009-03-31'. I've already got a bit of script that I can use to allow the user to specify the data and the folder in which these spreadsheets live. The data in each originating spreadsheet is in rows and the actual data to be copied is determined by an Autofilter in field 30 being "x". The number of rows could 1 to 1000. Any help you can provide will be greatly appreciated. Many thanks, |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copying data from several spreadsheets into a new spreadsheet
try this
Sub MakeSummary() Set SumSht = ThisWorkbook.Sheets("Summary") 'Create a FileDialog object as a File Picker dialog box. Set fd = Application.FileDialog(msoFileDialogFolderPicker) 'Use a With...End With block to reference the FileDialog object. With fd 'Set the initial path to the C:\ drive. .InitialFileName = "C:\Documents and Settings\All\My Documents" 'Use the Show method to display the File Picker dialog box and return the user's action. 'If the user presses the button... If .Show = -1 Then Folder = .SelectedItems.Item(1) 'If the user presses Cancel... Else MsgBox ("Cannot open Folder - Exiting Macro") Exit Sub End If End With 'Set the object variable to Nothing. Set fd = Nothing If Right(Folder, 1) < "\" Then Folder = Folder & "\" End If FName = Dir(Folder & "*.xls*") Do While FName < "" Set bk = Workbooks.Open(Folder & FName) For Each sht In bk.Sheets 'check if there is a space in the sheet name If InStr(sht.Name, " ") 0 Then 'get text to left of 1st space ShtDate = Trim(Left(sht.Name, InStr(sht.Name, " "))) End If 'only process sheet names with dates If IsDate(ShtDate) Then 'get 1st empty tow insummary sheet LastRow = SumSht.Range("A" & Rows.Count).End(xlUp).Row NewRow = LastRow + 1 'get last row from newly opened book LastRow = sht.Range("A" & Rows.Count).End(xlUp).Row 'copy rows from opened workbbook 'put data into this workbook 'skip row 1 sht.Rows("2:" & LastRow).Copy _ Destination:=SumSht.Rows(NewRow) End If Next sht bk.Close savechanges:=False FName = Dir() Loop End Sub "Mike Magill" wrote: Hi, I'm pretty much a novice at Excel macros so forgive me if I don't understand your responses the first time. I want to write a macro that will open a variable number of spreadsheets in a specific folder and copy a range of a variable number of rows from each spreadsheet into a single new spreadsheet with each range being copied immediately below the previous range. Each originating spreadsheet name will start with the date (e.g. 2009-03-31 Rest of spreadsheet name.xls) so I want the macro to open all spreadsheets in the folder starting with '2009-03-31'. I've already got a bit of script that I can use to allow the user to specify the data and the folder in which these spreadsheets live. The data in each originating spreadsheet is in rows and the actual data to be copied is determined by an Autofilter in field 30 being "x". The number of rows could 1 to 1000. Any help you can provide will be greatly appreciated. Many thanks, |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copying data from several spreadsheets into a new spreadsheet
This works for me....You will need to create a "click box" to start the macro
(but NOT on the sheet you are importing to. Or you could put this code in the sub Workbook_Open(). Sub ImportSheet() Sheets("SHEET1").Activate Response = MsgBox("Are you sure you want to do this?" & Chr(13) & "This will delete any current data on this worksheet", vbYesNo) If Response = vbNo Then Exit Sub FileName = Application.InputBox(Prompt:="Enter the EXACT File Name of the workbook you wish" & Chr(13) & "to import from the DATA folder on the C drive: ", Type:=2) With ActiveSheet.QueryTables.Add(Connection:=Array( _ "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password=" """;User ID=Admin;Data Source=C:\DATA\" & FileName & ".xls;M" _ , _ "ode=Share Deny Write;Extended Properties=""HDR=YES;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database P" _ , _ "assword="""";Jet OLEDB:Engine Type=35;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk " _ , _ "Transactions=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OL" _ , _ "EDB:Don't Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _ ), Destination:=Range("A1")) .CommandType = xlCmdTable .CommandText = Array("WORKLOG$A1:AA10000") .Name = Filename .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = False .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = False .AdjustColumnWidth = False .RefreshPeriod = 0 .PreserveColumnInfo = True .SourceDataFile = "C:\DATA\" & FileName & ".xls" .Refresh BackgroundQuery:=False .MaintainConnection = False End With "Mike Magill" wrote: Hi, I'm pretty much a novice at Excel macros so forgive me if I don't understand your responses the first time. I want to write a macro that will open a variable number of spreadsheets in a specific folder and copy a range of a variable number of rows from each spreadsheet into a single new spreadsheet with each range being copied immediately below the previous range. Each originating spreadsheet name will start with the date (e.g. 2009-03-31 Rest of spreadsheet name.xls) so I want the macro to open all spreadsheets in the folder starting with '2009-03-31'. I've already got a bit of script that I can use to allow the user to specify the data and the folder in which these spreadsheets live. The data in each originating spreadsheet is in rows and the actual data to be copied is determined by an Autofilter in field 30 being "x". The number of rows could 1 to 1000. Any help you can provide will be greatly appreciated. Many thanks, |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Copying worksheets or data to other spreadsheets | Excel Programming | |||
Copying Data Between Two Spreadsheets | Excel Programming | |||
Copying Data Between Two Spreadsheets | Excel Programming | |||
Copying Data from various spreadsheets | Excel Programming | |||
Copying spreadsheets in directory into master spreadsheet | Excel Programming |