Import *.csv formatted multiple files from folder in to excel

Kishan · Apr 21, 2019

Using Excel 2000

Hi,

I have created one folder on desktop and named "csvfiles" when I receive a new file I just add into this folder (in the same folder I have put one excel workbook named "csvfilestoexcel" 

I want I code when I open "csvfilestoexcel" and run the macro it list all the files are in to the folder "csvfilestoexcel" in the sheet1 into the column A and then all "csvfiles" are listed in the sheet1 import them one by one in the sheet "Imported"

Is it possible?

This is code I have recorded and imported 2 columns data from 2 files a1 & a2 and paste them transpose in to sheet "Imported" need a code which can do import all files automatically

Code:

Sub Import_Csvfiles()
    Sheets("Imported").Select
    ChDir "D:\Desktop\csvfiles"
    Workbooks.Open Filename:="D:\Desktop\csvfiles\a1.csv"
    Range("C1:C14").Select
    Selection.Copy
    Windows("csvfilestoexcel.xls").Activate
    Range("D10").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Range("S10").Select
    Windows("a1.csv").Activate
    Range("D1:D14").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("csvfilestoexcel.xls").Activate
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Range("D11").Select
    Windows("a1.csv").Activate
    ActiveWindow.Close
    
    
    Workbooks.Open Filename:="D:\Desktop\csvfiles\a2.csv"
    Range("C1:C14").Select
    Selection.Copy
    Windows("csvfilestoexcel.xls").Activate
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Range("S11").Select
    Windows("a2.csv").Activate
    Range("D1:D14").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("csvfilestoexcel.xls").Activate
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Range("D9").Select
    Windows("a2.csv").Activate
    ActiveWindow.Close
    ActiveWorkbook.Save

End Sub

Example of imported files

Book1

A

B

C

D

E

F

G

H

I

J

K

L

M

N

O

P

Q

R

S

T

U

V

W

X

Y

Z

AA

AB

AC

AD

AE

AF

AG

AH

1

2

3

4

5

6

7

8

9

10

46,3

46,8

90

56,6

26,6

30,9

55,3

31,8

37,1

43

59,6

43,8

57,5

65,4

28,9

28,4

7,44

25,5

25,8

30,2

27,1

32,9

32,3

31,5

26,5

29,7

27,8

24,1

11

32,5

4,46

30,7

55,2

10,4

38,2

59,1

28,7

40,4

58,3

35,1

60,1

53,5

30,6

29

10,8

29,2

24,4

17,7

29,2

25,5

32,9

33,2

27

31,3

27,4

27

32,2

12

13

14

Imported

Thank you in advance

Regards,
Kishan

DanteAmor · Apr 21, 2019

Try this

Adjust the data in blue with your information.

Code:

Sub Import_Csvfiles()
    Dim sh1 As Worksheet, sh2 As Worksheet, wb1 As Workbook, wb2 As Workbook
    Dim wPath As String, arch As Variant, i As Long
    
    Application.ScreenUpdating = False
    Set wb1 = ThisWorkbook
    Set sh1 = wb1.Sheets("[COLOR=#0000ff]Imported[/COLOR]")
    
    wPath = "[COLOR=#0000ff]D:\Desktop\csvfiles\[/COLOR]"
[COLOR=#0000ff]    i = 10[/COLOR]
    arch = Dir(wPath & "*.csv")
    Do While arch <> ""
        Set wb2 = Workbooks.Open(Filename:=wPath & arch)
        Set sh2 = wb2.Sheets(1)
        sh2.Range("[COLOR=#0000ff]C1:C14[/COLOR]").Copy
        sh1.Cells(i, "[COLOR=#0000ff]D[/COLOR]").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        i = i + 1
        wb2.Close False
        arch = Dir()
    Loop
    Application.ScreenUpdating = True
    MsgBox "Done"
End Sub

Kishan · Apr 21, 2019

DanteAmor said:

Try this

Adjust the data in blue with your information.

Code:

Sub Import_Csvfiles()
    Dim sh1 As Worksheet, sh2 As Worksheet, wb1 As Workbook, wb2 As Workbook
    Dim wPath As String, arch As Variant, i As Long
    
       Application.ScreenUpdating = True
    MsgBox "Done"
End Sub

DanteAmor, thank you for the macro it copy only one column, which is perfect!

Later I will see if I can modify to copy both.<o

></o

>
<o

></o

>
I need please can you add couples of things <o

></o

>
One for example if I put folder "csvfiles" in to other folder is it possible the path could be allocated where ever if file find auto path.<o

></o

>
<o

></o

>
Second is it possible list folder files by there older to latest time and dates in the column A in to sheet1 says for example <o

></o

>
<o

></o

>
Kind regards,<o

></o

>
Kishan

DanteAmor · Apr 21, 2019

Change this

Code:

wPath = "D:\Desktop\csvfiles\"

By:

Code:

wPath = [COLOR=#333333]wb1.path & "\"[/COLOR]

Kishan · Apr 21, 2019

DanteAmor said:
Change this

Code:

wPath = "D:\Desktop\csvfiles\"

By:

Code:

wPath = [COLOR=#333333]wb1.path & "\"[/COLOR]

DanteAmor, this change worked spot on now no problem I can put folder where I want the code detect path automatically very clever. 

I tried to incorporate modification inside the code so it can copy the Range("D1:D14") starting from S10 but could not get it work.

May I have duplicate the code and run first one and then second to do copy both as per post#1? 

Thank you so much for you help

Kind regards,
Kishan

DanteAmor · Apr 21, 2019

Try this

Code:

Sub Import_Csvfiles()
    Dim sh1 As Worksheet, sh2 As Worksheet, wb1 As Workbook, wb2 As Workbook
    Dim wPath As String, arch As Variant, i As Long
    
    Application.ScreenUpdating = False
    Set wb1 = ThisWorkbook
    Set sh1 = wb1.Sheets("Imported")
    
    wPath = "D:\Desktop\csvfiles\"
    i = 10
    arch = Dir(wPath & "*.csv")
    Do While arch <> ""
        Set wb2 = Workbooks.Open(Filename:=wPath & arch)
        Set sh2 = wb2.Sheets(1)
        sh2.Range("C1:C14").Copy
        sh1.Cells(i, "D").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        sh2.Range("D1:D14").Copy
        sh1.Cells(i, "S").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True


        i = i + 1
        wb2.Close False
        arch = Dir()
    Loop
    Application.ScreenUpdating = True
    MsgBox "Done"
End Sub

Kishan · Apr 22, 2019

DanteAmor said:

Try this

Code:

Sub Import_Csvfiles()
    Dim sh1 As Worksheet, sh2 As Worksheet, wb1 As Workbook, wb2 As Workbook
    Dim wPath As String, arch As Variant, i As Long
    
    Application.ScreenUpdating = False
    Set wb1 = ThisWorkbook
    Set sh1 = wb1.Sheets("Imported")
    
    wPath = "D:\Desktop\csvfiles\"
    i = 10
    arch = Dir(wPath & "*.csv")
    Do While arch <> ""
        Set wb2 = Workbooks.Open(Filename:=wPath & arch)
        Set sh2 = wb2.Sheets(1)
        sh2.Range("C1:C14").Copy
        sh1.Cells(i, "D").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        sh2.Range("D1:D14").Copy
        sh1.Cells(i, "S").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True


        i = i + 1
        wb2.Close False
        arch = Dir()
    Loop
    Application.ScreenUpdating = True
    MsgBox "Done"
End Sub

Hi DanteAmor,

Thank you for the code, it worked perfectly as per my request.

What I want now are 2 things additional to the above, if possible;
1) is for the files to open and update data by order; from older hours/date to latest.
2) the name of the worksheet to update in column C, next to the data. For example a1.csv in cell C10 and a2.csv in cell C11

Kind Regards,
Kishan

DanteAmor · Apr 22, 2019

I put the name in column B and the last update date in column C, with that you can now order the records from highest to lowest or from lowest to highest.

Code:

Sub Import_Csvfiles()
    Dim sh1 As Worksheet, sh2 As Worksheet, wb1 As Workbook, wb2 As Workbook
    Dim wPath As String, arch As Variant, i As Long
    Dim fso As Variant, carpeta As Variant, ficheros As Variant, archivo As Variant
    
    Application.ScreenUpdating = False
    Set wb1 = ThisWorkbook
    Set sh1 = wb1.Sheets("Imported")
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    wPath = wb1.Path & "\"
    
    Set carpeta = fso.GetFolder(wPath)
    Set ficheros = carpeta.Files
    
    i = 10
    'arch = Dir(wPath & "*.csv")
    'Do While arch <> ""
    For Each archivo In ficheros
        If LCase(Right(archivo, 3)) = "csv" Then
            Set wb2 = Workbooks.Open(Filename:=archivo)
            Set sh2 = wb2.Sheets(1)
            sh2.Range("C1:C14").Copy
            sh1.Cells(i, "D").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
            sh1.Cells(i, "B").Value = archivo.Name
            sh1.Cells(i, "C").Value = archivo.DateLastModified
            i = i + 1
            wb2.Close False
            'arch = Dir()
        End If
    Next
    'Loop
    Application.ScreenUpdating = True
    MsgBox "Done"
End Sub

Kishan · Apr 22, 2019

DanteAmor said:
I put the name in column B and the last update date in column C, with that you can now order the records from highest to lowest or from lowest to highest.

Code:

Sub Import_Csvfiles() Dim sh1 As Worksheet, sh2 As Worksheet, wb1 As Workbook, wb2 As Workbook Dim wPath As String, arch As Variant, i As Long Dim fso As Variant, carpeta As Variant, ficheros As Variant, archivo As Variant End If Next 'Loop Application.ScreenUpdating = True MsgBox "Done" End Sub

Hi DanteAmor,

Thank you so much I like the column B&C updating idea 

here is the resulting data where the a1 is the older and a21 is the latest. and if I sort them it remain the same. would not it be good that VBA import a1..to...a21.... 

Result data...

Book1

A

B

C

D

E

F

G

H

I

J

K

L

M

N

O

P

Q

R

S

1

2

3

4

5

6

7

8

9

10

a1.csv

22/04/2019 12:40

101

62,3

215

6,5

122

103

169

147

80,7

93,5

397

184

342

135

11

a10.csv

22/04/2019 12:41

286

60,2

239

186

119

176

156

258

35,2

159

107

234

324

29,2

12

a11.csv

22/04/2019 12:41

372

177

86,6

300

67,2

342

330

186

185

385

103

245

94,2

32,4

13

a12.csv

22/04/2019 12:41

283

304

243

231

11,1

7,12

176

300

59,4

246

218

324

121

320

14

a2.csv

22/04/2019 12:40

61,2

196

92,4

334

56

187

244

368

93,6

98,1

99,1

182

395

87,7

15

a20.csv

22/04/2019 12:41

287

272

69,6

174

129

225

24,3

96,1

29,5

136

328

3,34

190

324

16

a21.csv

22/04/2019 12:41

369

70,2

355

276

325

250

380

61,1

354

390

347

204

223

114

17

a3.csv

22/04/2019 12:40

7,19

55,3

351

337

160

263

75,7

262

104

244

1,78

24,2

228

260

18

a4.csv

22/04/2019 12:40

368

171

74

324

114

152

93,9

348

64,3

386

372

364

38,8

114

19

a5.csv

22/04/2019 12:40

241

189

288

244

31

38,1

242

6,41

15,6

361

152

253

54,5

272

20

a6.csv

22/04/2019 12:40

346

224

147

68,6

145

111

282

291

273

187

130

234

90,6

64,4

21

a7.csv

22/04/2019 12:41

278

349

141

137

347

343

360

4,63

84,4

316

169

82,7

260

194

22

a8.csv

22/04/2019 12:41

128

202

165

263

54,3

308

177

104

168

1,81

268

36,2

330

152

23

a9.csv

22/04/2019 12:41

239

79,6

314

118

162

127

297

382

344

268

332

266

168

292

24

25

Imported

Kind Regards,
Kishan

DanteAmor · Apr 22, 2019

Vba imports them as they are in the folder, for that you have the columns, to sort by date, check that it really is a date and not a text

Import *.csv formatted multiple files from folder in to excel

Kishan

Well-known Member

Excel Facts

DanteAmor

Well-known Member

Kishan

Well-known Member

DanteAmor

Well-known Member

Kishan

Well-known Member

DanteAmor

Well-known Member

Kishan

Well-known Member

DanteAmor

Well-known Member

Kishan

Well-known Member

DanteAmor

Well-known Member

Similar threads

Forum statistics

Share this page

Import *.csv formatted multiple files from folder in to excel

Well-known Member

Excel Facts

Well-known Member

Well-known Member

Well-known Member

Well-known Member

Well-known Member

Well-known Member

Well-known Member

Well-known Member

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock