| Home |
| Search |
| Today's Posts |
|
|
|
#1
Posted to microsoft.public.excel.newusers
|
|||
|
|||
Copying Multiple files in one file Macro - Liz
Hi,
I recorded this macro to copy the data from a particular formatted file to a normal worksheet. In order to get it in a normal format (All Testing Results.xls) in order to import it to my Database Table. And it worked. Now I'm in a process to creat a macro that will automate the process of going to that folder (C:\To Figure Out\) and copy all the datas from the different files that is in that folder and copy it in my normal worksheet (All Testing Results.xls). Please help. Here's the Macro that I recorded to copy paste my data in normal format to All Testing Results.xls and it worked. Sub UpdateWTAuditResults() ' ' UpdateWTAuditResults Macro ' Macro recorded 3/8/2007 by Elizabeth B Cherian ' ' Workbooks.Open Filename:="C:\To Figure out\WTKLoder102406.xls" Range("F7:G7").Select Selection.Copy Windows("All Testing Results.xls").Activate Range("B2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Windows("WTKLoder102406.xls").Activate Range("F5:G5").Select Application.CutCopyMode = False Selection.Copy Windows("WTKLoder121506.xls").Activate Windows("All Testing Results.xls").Activate Range("C2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("E2").Select Windows("WTKLoder102406.xls").Activate Range("B7:C7").Select Application.CutCopyMode = False Selection.Copy Windows("All Testing Results.xls").Activate Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Columns("E:E").ColumnWidth = 10.43 Range("E2").Select Application.CutCopyMode = False Selection.Cut Range("F2").Select ActiveSheet.Paste Range("E2").Select ActiveCell.FormulaR1C1 = "CREBnkg" Range("H2").Select Windows("WTKLoder102406.xls").Activate Range("B9:C9").Select Selection.Copy Windows("WTKLoder121506.xls").Activate Windows("All Testing Results.xls").Activate Range("I2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("J2").Select Windows("WTKLoder102406.xls").Activate Range("B5:C5").Select Application.CutCopyMode = False Selection.Copy Windows("All Testing Results.xls").Activate Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("K2").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "Monthly" Range("L2").Select ActiveCell.FormulaR1C1 = "43" Range("N2").Select ActiveCell.FormulaR1C1 = "WT" Range("O2").Select ActiveCell.FormulaR1C1 = "Wire Transfer" Range("P2").Select Windows("WTKLoder102406.xls").Activate Range("A15:D57").Select Selection.Copy Windows("All Testing Results.xls").Activate Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("AB2").Select Windows("WTKLoder102406.xls").Activate Range("E15:E57").Select Application.CutCopyMode = False Selection.Copy Windows("All Testing Results.xls").Activate ActiveSheet.Paste Range("AE2").Select Windows("WTKLoder102406.xls").Activate Range("F15:F57").Select Application.CutCopyMode = False Selection.Copy Windows("All Testing Results.xls").Activate Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("AM2").Select Windows("WTKLoder102406.xls").Activate Range("G15:N57").Select Application.CutCopyMode = False Selection.Copy Windows("All Testing Results.xls").Activate Range("AF2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("B2:O2").Select Application.CutCopyMode = False Selection.Copy Range("B3:B44").Select ActiveSheet.Paste Application.CutCopyMode = False Range("A2:AM44").Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With Range("C59").Select ActiveWorkbook.Save End Sub |
|
#2
Posted to microsoft.public.excel.newusers
|
|||
|
|||
|
Copying Multiple files in one file Macro - Liz
Hello Liz,
you might like to try something like this: Sub Gather_files() ' Obtain list of filenames from folder ' Dim my_row As Integer Dim my_file As String Dim my_path As String my_path = "C:\To Figure Out\" 'obtain list of files from that folder Sheets("Files").Select Range("A1").Select my_row = 1 'write file list to Files sheet my_file = Dir(my_path & "*.xls") Do Until my_file = "" Cells(my_row, 1) = my_file my_row = my_row + 1 my_file = Dir Loop num_files = my_row - 1 End sub This will give you a list of filenames (xls files) from the folder in column A of worksheet "Files" (which should be created first). From here in another sub you could open each of these files in turn then copy the data to your All Testing Results.xls - you could record a macro while you do this a few times, so that you could then see the statements common to each file. Record the macro with relative addressing switched on. You could end up with something like this: 'select each file in turn For i = 1 To num_files Sheets("Files").Select curr_file = Cells(i, 1).Value Sheets("Sheet1").Select 'open file and copy to bottom of calls sheet Workbooks.Open Filename:=my_path & curr_file 'your code, copying data, switching windows, pasting data, closing current file etc. Next i I did something very similar to this earlier this week, which is why I have the code handy. Hope this helps. Pete On Mar 8, 8:00 pm, Liz wrote: Hi, I recorded this macro to copy the data from a particular formatted file to a normal worksheet. In order to get it in a normal format (All Testing Results.xls) in order to import it to my Database Table. And it worked. Now I'm in a process to creat a macro that will automate the process of going to that folder (C:\To Figure Out\) and copy all the datas from the different files that is in that folder and copy it in my normal worksheet (All Testing Results.xls). Please help. Here's the Macro that I recorded to copy paste my data in normal format to All Testing Results.xls and it worked. Sub UpdateWTAuditResults() ' ' UpdateWTAuditResults Macro ' Macro recorded 3/8/2007 by Elizabeth B Cherian ' ' Workbooks.Open Filename:="C:\To Figure out\WTKLoder102406.xls" Range("F7:G7").Select Selection.Copy Windows("All Testing Results.xls").Activate Range("B2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Windows("WTKLoder102406.xls").Activate Range("F5:G5").Select Application.CutCopyMode = False Selection.Copy Windows("WTKLoder121506.xls").Activate Windows("All Testing Results.xls").Activate Range("C2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("E2").Select Windows("WTKLoder102406.xls").Activate Range("B7:C7").Select Application.CutCopyMode = False Selection.Copy Windows("All Testing Results.xls").Activate Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Columns("E:E").ColumnWidth = 10.43 Range("E2").Select Application.CutCopyMode = False Selection.Cut Range("F2").Select ActiveSheet.Paste Range("E2").Select ActiveCell.FormulaR1C1 = "CREBnkg" Range("H2").Select Windows("WTKLoder102406.xls").Activate Range("B9:C9").Select Selection.Copy Windows("WTKLoder121506.xls").Activate Windows("All Testing Results.xls").Activate Range("I2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("J2").Select Windows("WTKLoder102406.xls").Activate Range("B5:C5").Select Application.CutCopyMode = False Selection.Copy Windows("All Testing Results.xls").Activate Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("K2").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "Monthly" Range("L2").Select ActiveCell.FormulaR1C1 = "43" Range("N2").Select ActiveCell.FormulaR1C1 = "WT" Range("O2").Select ActiveCell.FormulaR1C1 = "Wire Transfer" Range("P2").Select Windows("WTKLoder102406.xls").Activate Range("A15:D57").Select Selection.Copy Windows("All Testing Results.xls").Activate Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("AB2").Select Windows("WTKLoder102406.xls").Activate Range("E15:E57").Select Application.CutCopyMode = False Selection.Copy Windows("All Testing Results.xls").Activate ActiveSheet.Paste Range("AE2").Select Windows("WTKLoder102406.xls").Activate Range("F15:F57").Select Application.CutCopyMode = False Selection.Copy Windows("All Testing Results.xls").Activate Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("AM2").Select Windows("WTKLoder102406.xls").Activate Range("G15:N57").Select Application.CutCopyMode = False Selection.Copy Windows("All Testing Results.xls").Activate Range("AF2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("B2:O2").Select Application.CutCopyMode = False Selection.Copy Range("B3:B44").Select ActiveSheet.Paste Application.CutCopyMode = False Range("A2:AM44").Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With Range("C59").Select ActiveWorkbook.Save End Sub |
|
#3
Posted to microsoft.public.excel.newusers
|
|||
|
|||
|
Copying Multiple files in one file Macro - Liz
Thanks Pete I'm going to try it today and see it it works.
Thanks a lot. Liz "Pete_UK" wrote: Hello Liz, you might like to try something like this: Sub Gather_files() ' Obtain list of filenames from folder ' Dim my_row As Integer Dim my_file As String Dim my_path As String my_path = "C:\To Figure Out\" 'obtain list of files from that folder Sheets("Files").Select Range("A1").Select my_row = 1 'write file list to Files sheet my_file = Dir(my_path & "*.xls") Do Until my_file = "" Cells(my_row, 1) = my_file my_row = my_row + 1 my_file = Dir Loop num_files = my_row - 1 End sub This will give you a list of filenames (xls files) from the folder in column A of worksheet "Files" (which should be created first). From here in another sub you could open each of these files in turn then copy the data to your All Testing Results.xls - you could record a macro while you do this a few times, so that you could then see the statements common to each file. Record the macro with relative addressing switched on. You could end up with something like this: 'select each file in turn For i = 1 To num_files Sheets("Files").Select curr_file = Cells(i, 1).Value Sheets("Sheet1").Select 'open file and copy to bottom of calls sheet Workbooks.Open Filename:=my_path & curr_file 'your code, copying data, switching windows, pasting data, closing current file etc. Next i I did something very similar to this earlier this week, which is why I have the code handy. Hope this helps. Pete On Mar 8, 8:00 pm, Liz wrote: Hi, I recorded this macro to copy the data from a particular formatted file to a normal worksheet. In order to get it in a normal format (All Testing Results.xls) in order to import it to my Database Table. And it worked. Now I'm in a process to creat a macro that will automate the process of going to that folder (C:\To Figure Out\) and copy all the datas from the different files that is in that folder and copy it in my normal worksheet (All Testing Results.xls). Please help. Here's the Macro that I recorded to copy paste my data in normal format to All Testing Results.xls and it worked. Sub UpdateWTAuditResults() ' ' UpdateWTAuditResults Macro ' Macro recorded 3/8/2007 by Elizabeth B Cherian ' ' Workbooks.Open Filename:="C:\To Figure out\WTKLoder102406.xls" Range("F7:G7").Select Selection.Copy Windows("All Testing Results.xls").Activate Range("B2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Windows("WTKLoder102406.xls").Activate Range("F5:G5").Select Application.CutCopyMode = False Selection.Copy Windows("WTKLoder121506.xls").Activate Windows("All Testing Results.xls").Activate Range("C2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("E2").Select Windows("WTKLoder102406.xls").Activate Range("B7:C7").Select Application.CutCopyMode = False Selection.Copy Windows("All Testing Results.xls").Activate Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Columns("E:E").ColumnWidth = 10.43 Range("E2").Select Application.CutCopyMode = False Selection.Cut Range("F2").Select ActiveSheet.Paste Range("E2").Select ActiveCell.FormulaR1C1 = "CREBnkg" Range("H2").Select Windows("WTKLoder102406.xls").Activate Range("B9:C9").Select Selection.Copy Windows("WTKLoder121506.xls").Activate Windows("All Testing Results.xls").Activate Range("I2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("J2").Select Windows("WTKLoder102406.xls").Activate Range("B5:C5").Select Application.CutCopyMode = False Selection.Copy Windows("All Testing Results.xls").Activate Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("K2").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "Monthly" Range("L2").Select ActiveCell.FormulaR1C1 = "43" Range("N2").Select ActiveCell.FormulaR1C1 = "WT" Range("O2").Select ActiveCell.FormulaR1C1 = "Wire Transfer" Range("P2").Select Windows("WTKLoder102406.xls").Activate Range("A15:D57").Select Selection.Copy Windows("All Testing Results.xls").Activate Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("AB2").Select Windows("WTKLoder102406.xls").Activate Range("E15:E57").Select Application.CutCopyMode = False Selection.Copy Windows("All Testing Results.xls").Activate ActiveSheet.Paste Range("AE2").Select Windows("WTKLoder102406.xls").Activate Range("F15:F57").Select Application.CutCopyMode = False Selection.Copy Windows("All Testing Results.xls").Activate Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("AM2").Select Windows("WTKLoder102406.xls").Activate Range("G15:N57").Select Application.CutCopyMode = False Selection.Copy Windows("All Testing Results.xls").Activate Range("AF2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("B2:O2").Select Application.CutCopyMode = False Selection.Copy Range("B3:B44").Select ActiveSheet.Paste Application.CutCopyMode = False Range("A2:AM44").Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With Range("C59").Select ActiveWorkbook.Save End Sub |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| Macro: Filter Multiple header then extract to Multiple Files | Excel Discussion (Misc queries) | |||
| Copying data to multiple worksheets by Macro | Excel Discussion (Misc queries) | |||
| Opening Multiple files and Copying the info all to one other sheet | Excel Discussion (Misc queries) | |||
| macro for copying file | Excel Discussion (Misc queries) | |||
| Help with Macro (copying data from multiple workbooks) | Excel Discussion (Misc queries) | |||
Hybrid Mode
