May 31 2019 08:27 AM
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
May 31 2019 11:02 AM
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
Jun 24 2019 05:14 AM
Hello @Berndvbatanker
Can you help me to get this code in English? Finding it difficult to understand the terms/words used.
Regards,
Chandrakanth.K
Jun 24 2019 06:39 AM - edited Jun 24 2019 06:40 AM
Solutionok.
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
Jun 24 2019 06:39 AM - edited Jun 24 2019 06:40 AM
Solutionok.
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