Transfer data from .csv files to a workbook

Question

I'm trying to code a Macro in Excel that:

Goes through hundreds of .csv files.
Get their names and put them in the first row of the target workbook.
Copy columns E & R from each .csv file and paste them below their corresponding name in the target workbook.

Example: in the target workbook, I should get, the title_1 (of csv_1) in cell A1, then data from columns E & R of csv_1 pasted in cells A2 & B2. Column C empty. Then title_2 (of csv_2) in cell D1, respective columns E & R pasted in D2 & E2. Column F empty and so on...

I would like the data to be organize like this

Attempt:

Sub LoopExcels ()
    
    Dim directory As String
    Dim fileName As String
    Dim i As Integer
    Dim j As Integer
    Dim wb As Workbook
    Dim wbSource As Workbook
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim ColOutputTarget As Long
    
    ColOutputTarget = 1
    
    Set wsTarget = Sheets("Sheet1")
    
    Application.ScreenUpdating = FALSE
    Application.DisplayAlerts = FALSE
    
    directory = "C:\data"
    fileName = Dir(directory & "*.csv")
    
    Do Until fileName = ""
        
        Set wbSource = Workbooks.Open(directory & fileName)
        Set wsSource = wbSource.Worksheets(1)
        
        j = j + 1
        i = 1
        Cells(i, 1) = fileName
        
        Workbooks.Open (directory & fileName)
        
        For Each sheet In Workbooks(fileName).Worksheets        'my excels contain only one sheet but didn't know how to get rid of the "For each sheet"
            wsTarget.Cells(i, j).Value = sheet.Name
            j = j + 2
            
        Next sheet
        
        With wsTarget
            .Range("A" & ColOutputTarget).Value = wsSource.Range("E1:E100").Value        'Need to copy all data in columns it can be 10 cells and it doesn't exceed 100 cells
            .Range("B" & ColOutputTarget).Value = wsSource.Range("R1:R100").Value
            
            ColOutputTarget = ColOutputTarget + 1
            
        End With
        
        wbSource.Close SaveChanges:=False
        
        fileName = Dir()
        
    Loop
    
    Application.CutCopyMode = FALSE
    
End Sub

I've been looking for a solution with no luck.

I found a way to loop through files
I managed partially to get the names of each file (I found a code that goes thru all sheets in an Excel file. My files contain only one sheet so maybe it can be simplified) And for some reason it doesn't copy the full name. some files have LONG names +50 characters.
I am having issues with copy/pasting the columns. Each column has data from 10 to 100 cells. The code below, go thru the files but paste the data in the same column. I end up getting only the data from the last excel file it opens which get pasted in the first 2 columns. I can't find a way to make it shift to the next column every time its done with each csv file.

Gass · Accepted Answer

For order to work:

you need to place the Excel file (that has the macro) inside the folder of the .CSV files.
create 2 sheets in the main Excel file with the names "file names" and "target sheet". You can change this in the code if you want.
if you are using Windows just insert the path of the folder containing the .csv files.

if you are using mac insert the path of the folder containing the .csv files and change all the "\" in the macro to "/".

Sub Awesome()

getNames
positionTitles
transferData

End Sub

Sub getNames()

  Dim sFilePath As String
  Dim sFileName As String
  Dim counter As Long

  counter = 1

  'Specify folder Path for the .csv files
  sFilePath = "c:\"

  'Check for back slash
  If Right(sFilePath, 1) <> "\" Then
      sFilePath = sFilePath & "\"
  End If

  sFileName = Dir(sFilePath & "*.csv")

  Do While Len(sFileName) > 0
      If Right(sFileName, 3) = "csv" Then
          'Display file name in immediate window
           Sheets("file names").Cells(counter, 1) = sFileName
          counter = counter + 1
      End If
      'Set the fileName to the next available file
      sFileName = Dir
  Loop

End Sub


Sub positionTitles()

Dim counter As Long
Dim used_range As Range
Dim col As Long

col = 1

Set used_range = Sheets("file names").UsedRange

For counter = 1 To used_range.Rows.Count

Sheets("target sheet").Cells(1, col) = Sheets("file names").Cells(counter, 1)

col = col + 4

Next counter

End Sub


Sub transferData()

'turn off unnecessary applications
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.DisplayAlerts = False

Dim file_name As String
Dim counter As Long
Dim used_range As Range
Dim main_wb As Workbook
Dim col As Long
Dim key As Boolean
Dim last_row As Long
Dim second_key As Boolean

col = 1

Set main_wb = ThisWorkbook
Set used_range = Sheets("file names").UsedRange


For counter = 1 To used_range.Rows.Count

  file_name = main_wb.Sheets("file names").Cells(counter, 1)

  Workbooks.Open ActiveWorkbook.Path & "\" & file_name, Local:=True

  'transfer data to target_sheet
  For col = col To 1000

      If key = False Then
          last_row = ActiveWorkbook.ActiveSheet.Range("E" & Rows.Count).End(xlUp).Row
          ActiveWorkbook.ActiveSheet.Range("E1:E" & last_row).Copy
          main_wb.Sheets("target sheet").Cells(2, col).PasteSpecial
          key = True
      ElseIf second_key = False Then
       last_row = ActiveWorkbook.ActiveSheet.Range("R" & Rows.Count).End(xlUp).Row
      ActiveWorkbook.ActiveSheet.Range("R1:R" & last_row).Copy
      main_wb.Sheets("target sheet").Cells(2, col).PasteSpecial
      second_key = True
   Else
      last_row = ActiveWorkbook.ActiveSheet.Range("K" & Rows.Count).End(xlUp).Row
      ActiveWorkbook.ActiveSheet.Range("K1:K" & last_row).Copy
      main_wb.Sheets("target sheet").Cells(2, col).PasteSpecial
      col = col + 2
      Exit For
  End If

  Next col

  key = False
  second_key = False
  Workbooks(file_name).Close savechanges:=False

Next counter

'turn on applications
Application.ScreenUpdating = True
Application.Calculation = xlCalculationManual
Application.EnableEvents = True
Application.DisplayAlerts = True
Application.DisplayAlerts = True

End Sub

Transfer data from .csv files to a workbook

Answers (1)

Related Questions