Copying Multiple files in one file Macro - Liz

[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("A1557").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

 

[Pete_UK]

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

 

[Liz]

Thanks Pete I'm going to try it today and see it it works.

Thanks a lot.
Liz