SOLVED

Loop through Multiple files in share folder

Copper Contributor

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

 

3 Replies

@Chandrakanth K 

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 Sub

 

Regards

Bernd

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

best response confirmed by Chandrakanth K (Copper Contributor)
Solution

@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
1 best response

Accepted Solutions
best response confirmed by Chandrakanth K (Copper Contributor)
Solution

@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

View solution in original post