Forum Discussion

Chandrakanth K's avatar
Chandrakanth K
Copper Contributor
May 31, 2019
Solved

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 o...
Macros and VBA
  • Berndvbatanker's avatar
    Berndvbatanker
    Jun 24, 2019

    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
Chandrakanth K's avatar
Chandrakanth K
Copper Contributor
Jun 24, 2019

Hello Berndvbatanker 

 

Can you help me to get this code in English? Finding it difficult to understand the terms/words used.

 

Regards,

Chandrakanth.K

Berndvbatanker's avatar
Berndvbatanker
Iron Contributor
Jun 24, 2019

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

Resources