Forum Discussion
Loop through Multiple files in share folder
Hello All,
I need to build a code which loops through multiple files in a folder and copy and paste the data to a template and drag formulas for 26 columns.
I was able to build code to open one file from source folder and copy paste data to a template and then save as template in another folder based on source file name.
Need help on how to loop through all the files in a folder.
Below is my existing code
Public Sub OIM()
Dim a, b As String
Range("A1").Select
a = ActiveCell.Value
Range("A2").Select
b = ActiveCell.Value
Workbooks.Open (a)
Workbooks.Open (b)
Range("A2:AI2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("OIM ResultFile_Template Final.xlsb").Activate
Range("A7").Select
ActiveSheet.Paste
Range("AJ7").Select
Selection.Copy
Range("A7").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 35).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.PasteSpecial
Range("AJ8").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("AK7").Select
Selection.Copy
Range("A7").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 36).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.PasteSpecial
Range("AK8").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
' Range("AK6").Select
' ActiveCell.Value = "Rule 1 - CC GL & PC / LOB"
Range("AL7").Select
Selection.Copy
Range("A7").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 37).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.PasteSpecial
Range("AL8").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("AM7").Select
Selection.Copy
Range("A7").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 38).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.PasteSpecial
Range("AM8").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("AN7").Select
Selection.Copy
Range("A7").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 39).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.PasteSpecial
Range("AN8").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("Ao7").Select
Selection.Copy
Range("A7").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 40).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.PasteSpecial
Range("Ao8").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("AP7").Select
Selection.Copy
Range("A7").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 41).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.PasteSpecial
Range("Ap8").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("AQ7").Select
Selection.Copy
Range("A7").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 42).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.PasteSpecial
Range("AQ8").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("AR7").Select
Selection.Copy
Range("A7").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 43).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.PasteSpecial
Range("AR8").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("AS7").Select
Selection.Copy
Range("A7").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 44).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.PasteSpecial
Range("AS8").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("AT7").Select
Selection.Copy
Range("A7").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 45).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.PasteSpecial
Range("AT8").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("AU7").Select
Selection.Copy
Range("A7").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 46).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.PasteSpecial
Range("AU8").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("AV7").Select
Selection.Copy
Range("A7").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 47).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.PasteSpecial
Range("AV8").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("AW7").Select
Selection.Copy
Range("A7").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 48).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.PasteSpecial
Range("AW8").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("AX7").Select
Selection.Copy
Range("A7").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 49).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.PasteSpecial
Range("AX8").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("Ay7").Select
Selection.Copy
Range("A7").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 50).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.PasteSpecial
Range("Ay8").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("AZ7").Select
Selection.Copy
Range("A7").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 51).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.PasteSpecial
Range("AZ8").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("BA7").Select
Selection.Copy
Range("A7").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 52).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.PasteSpecial
Range("BA8").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("BB7").Select
Selection.Copy
Range("A7").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 53).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.PasteSpecial
Range("BB8").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("BC7").Select
Selection.Copy
Range("A7").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 54).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.PasteSpecial
Range("BC8").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("BD7").Select
Selection.Copy
Range("A7").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 55).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.PasteSpecial
Range("BD8").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("BE7").Select
Selection.Copy
Range("A7").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 56).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.PasteSpecial
Range("BE8").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("BF7").Select
Selection.Copy
Range("A7").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 57).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.PasteSpecial
Range("BF8").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("BG7").Select
Selection.Copy
Range("A7").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 58).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.PasteSpecial
Range("BG8").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("BH7").Select
Selection.Copy
Range("A7").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 59).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.PasteSpecial
Range("BH8").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("BI7").Select
Selection.Copy
Range("A7").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 60).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.PasteSpecial
Range("BI8").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Dim path As String
Dim filename As String
path = "\\ie3bst0003\HGFC_Finance_OPS\5. Integrations\Daily Dash Boards\General Accounting\OIM Clearing\"
filename = Range("A7")
ActiveWorkbook.SaveAs filename:=path & filename & ".xls", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWorkbook.Save
ActiveWindow.Close
Application.DisplayAlerts = False
ActiveWindow.Close
MsgBox "Its done"
End Sub
ok.
Sub AllFilesInFolder()
Dim strPath As String
Dim strFile As String
Dim wkbSource As Workbook
Dim lngRowFree As Long
'adopt path
strPath = ThisWorkbook.Path & "\Data\"
strFile = Dir(strPath & "*.xls*")
With Sheet1
.Range("A2:B" & .Rows.Count).Clear
Do While strFile <> ""
Set wkbSource = Workbooks.Open(strPath & strFile)
lngRowFree = .Range("A" & .Rows.Count).End(xlUp).Row + 1
wkbSource.Worksheets("tbl_Preise").Range("A1:B5").Copy _
Destination:=.Range("A" & lngRowFree)
lngRowFree = .Range("A" & .Rows.Count).End(xlUp).Row + 1
wkbSource.Worksheets("Sheet1").Range("A1:B1").Copy _
Destination:=.Range("A" & lngRowFree)
wkbSource.Close savechanges:=False
strFile = Dir
Loop
End With
End Sub
3 Replies
Hi,
you can use this macro to do similar things..
Sub DateinAusVerzeichnisVerarbeiten()
Dim strOrdner As String
Dim strDatei As String
Dim wkbQuelle As Workbook
Dim lngZeileFrei As Long
'PFad anpassen
strOrdner = ThisWorkbook.Path & "\Daten\"
strDatei = Dir(strOrdner & "*.xls*")
With Sheet1
.Range("A2:B" & .Rows.Count).Clear
Do While strDatei <> ""
'Debug.Print strDatei
Set wkbQuelle = Workbooks.Open(strOrdner & strDatei)
lngZeileFrei = .Range("A" & .Rows.Count).End(xlUp).Row + 1
wkbQuelle.Worksheets("tbl_Preise").Range("A1:B5").Copy _
Destination:=.Range("A" & lngZeileFrei)
lngZeileFrei = .Range("A" & .Rows.Count).End(xlUp).Row + 1
wkbQuelle.Worksheets("Sheet1").Range("A1:B1").Copy _
Destination:=.Range("A" & lngZeileFrei)
wkbQuelle.Close savechanges:=False
strDatei = Dir
Loop
End With
End SubRegards
Bernd
http://www.vba-Tanker.com - the database full of macros
Hello Berndvbatanker
Can you help me to get this code in English? Finding it difficult to understand the terms/words used.
Regards,
Chandrakanth.K
ok.
Sub AllFilesInFolder()
Dim strPath As String
Dim strFile As String
Dim wkbSource As Workbook
Dim lngRowFree As Long
'adopt path
strPath = ThisWorkbook.Path & "\Data\"
strFile = Dir(strPath & "*.xls*")
With Sheet1
.Range("A2:B" & .Rows.Count).Clear
Do While strFile <> ""
Set wkbSource = Workbooks.Open(strPath & strFile)
lngRowFree = .Range("A" & .Rows.Count).End(xlUp).Row + 1
wkbSource.Worksheets("tbl_Preise").Range("A1:B5").Copy _
Destination:=.Range("A" & lngRowFree)
lngRowFree = .Range("A" & .Rows.Count).End(xlUp).Row + 1
wkbSource.Worksheets("Sheet1").Range("A1:B1").Copy _
Destination:=.Range("A" & lngRowFree)
wkbSource.Close savechanges:=False
strFile = Dir
Loop
End With
End Sub
