Vba - importing a cell value from multiple spreadsheets in a directory

[Cuzzaa]

Hi all,

Hope you can help.

I am using the code below for one of my macros to import a cell range from a different sheet selected by the user into my active workbook in a specific cell range, but is anyone able to help please to tweak the code please so that instead of clicking the button to select which file to import the data, instead, you select a folder directory and then it opens every unique .csv file within the folder, copies cell 'A1' (and closes the spreadsheet again) and then pastes it into my active work book in cell 'A1'?

I would then also like it to keep running until it has repeated the above steps for every unique file within the selected file directory, but in the active workbook pasting the value from cell 'A1' into 'A1', and then 'A1' into 'A2', then 'A1' into A3 and repeats until it's done it for all the .csv files in the folder?

Sub Import()

' Get customer workbook...
Dim customerBook As Workbook
Dim filter As String
Dim caption As String
Dim customerFilename As String
Dim customerWorkbook As Workbook
Dim targetWorkbook As Workbook

Dim aCount As Integer, msg As String
Const msg1 = "The BOM has been imported!" & vbCr & vbCr
Const msg2 = " item(s) could not be found." & vbCr & vbCr & "Please update the 'Lookup' sheet and then try again."
Const msg3 = "All items have been successfully imported."



' make weak assumption that active workbook is the target
Set targetWorkbook = Application.ActiveWorkbook


' get the customer workbook
filter = "Text files (*.xls),*.xls"
caption = "Please select the file "
customerFilename = Application.GetOpenFilename(filter, , caption)


Set customerWorkbook = Application.Workbooks.Open(customerFilename)


' assume range is A2 - K200 in sheet1
' copy data from customer to target workbook
Dim targetSheet As Worksheet
Set targetSheet = targetWorkbook.Worksheets(1)
Dim sourceSheet As Worksheet
Set sourceSheet = customerWorkbook.Worksheets(1)




targetSheet.Range("B13", "L1000").Value = sourceSheet.Range("A2", "K1000").Value


' Close customer workbook
customerWorkbook.Close


' targetSheet.Range("M3").Value = customerFilename


Range("A1").Select

MsgBox "Successfully imported!", vbInformation

End Sub

Any help would be honestly really appreciated!

Thanks so much

 

[JLGWhiz]

See if you can use this.

Sub t()
Dim fPath As String, fName As String, wb As Workbook, sh As Worksheet
Set sh = ActiveSheet
With Application.FileDialog(msoFileDialogFolderPicker)
    .Show
    fPath = .SelectedItems(1)
End With
    fName = Dir(fPath & "\" & "*.csv")
        Do While fName <> ""
            Set wb = Workbooks.Open(fPath & "\" & fName)
                wb.Sheets(1).Range("A1").Copy sh.Cells(Rows.Count, 1).End(xlUp)(2)
                wb.Close False
                fName = Dir
        Loop
End Sub

 

[Cuzzaa]

See if you can use this.

Sub t()
Dim fPath As String, fName As String, wb As Workbook, sh As Worksheet
Set sh = ActiveSheet
With Application.FileDialog(msoFileDialogFolderPicker)
    .Show
    fPath = .SelectedItems(1)
End With
    fName = Dir(fPath & "\" & "*.csv")
        Do While fName <> ""
            Set wb = Workbooks.Open(fPath & "\" & fName)
                wb.Sheets(1).Range("A1").Copy sh.Cells(Rows.Count, 1).End(xlUp)(2)
                wb.Close False
                fName = Dir
        Loop
End Sub

Hi JLGWhiz,

That's fantastic, thank you!

I have a question, is there a way to amend your code above to also pull in and print the path of the selected folder into the activebook in cell D10 for example?

Similar to what's happening below but instead for the folder directory?

CustomerFilename = Application.GetOpenFilename(filter, , caption)

Set customerWorkbook = Application.Workbooks.Open(customerFilename)

targetSheet.Range("D10").Value = customerFilename

 

[Cuzzaa]

Hi JLGWhiz

Sorry just in addition to the above query, is it also possible to amend your vba to pull in each of the filenames of the spreadsheets that are found in the directory, i.e. if the data that is being copied into the active workbook is printed to D13, then the filename of that spreadsheet is also printed in cell C13, and so on until the loop finishes?

Thanks so much!

 

[JLGWhiz]

This will list the fine path in column D for each source file and the file name in column E on the same line as the copied data from cell A1 of that workbook.

Sub t2()
Dim fPath As String, fName As String, wb As Workbook, sh As Worksheet
Set sh = ActiveSheet
With Application.FileDialog(msoFileDialogFolderPicker)
    .Show
    fPath = .SelectedItems(1)
End With
    fName = Dir(fPath & "\" & "*.csv")
        Do While fName <> ""
            Set wb = Workbooks.Open(fPath & "\" & fName)
                wb.Sheets(1).Range("A1").Copy sh.Cells(Rows.Count, 1).End(xlUp)(2)
                sh.Cells(Rows.Count, 1).End(xlUp).Offset(, 3) = fPath
                sh.Cells(Rows.Count, 4).End(xlUp).Offest(, 1) = fName
                wb.Close False
                fName = Dir
        Loop
        sh.Columns("D:E").Autofit
End Sub

 

[Cuzzaa]

Hi JLGWhiz

Thanks so much for that, I'm a little confused however, sorry I should have pasted the updated code that I'm using (see below).

This is putting the first value of cell E2 into my active workbook in cell D14, then D16, D18 etc. I am trying to print the filenames of each file into cell C14, C16, C18 etc.

For printing the pathname of the folder imported I am trying to print this into cell B10.

Please could I ask if you could amend the row count numbers so that the above locations are achieved as I'm struggling to understand the logic behind how to specify the exact locations I need?

Sub ImportChannels()

Dim fPath As String, fName As String, wb As Workbook, sh As Worksheet
Set sh = ActiveSheet
With Application.FileDialog(msoFileDialogFolderPicker)
    .Show
    fPath = .SelectedItems(1)
End With
    fName = Dir(fPath & "\" & "*.csv")
        Do While fName <> ""
            Set wb = Workbooks.Open(fPath & "\" & fName)
                wb.Sheets(1).Range("E2").Copy sh.Cells(Rows.Count, 4).End(xlUp)(3)
                wb.Close False
                fName = Dir
        Loop

End Sub

Thank you as always for offering your kind help.

 

[Cuzzaa]

Hi again,

I'm using the code below now, pulling in the pathname is fine I've managed to get that working but I'm still struggling to pull in each of the filenames.

Just for reference I'm pulling in the first value of cell E2 into my active workbook in cell D14, then D16, D18 etc. I am trying to print the filenames of each file into cell C14, C16, C18 etc. respectively.

Sub ImportChannels()

Dim fPath As String, fName As String, wb As Workbook, sh As Worksheet
Set sh = ActiveSheet
With Application.FileDialog(msoFileDialogFolderPicker)
    .Show
    fPath = .SelectedItems(1)
End With
    fName = Dir(fPath & "\" & "*.csv")
        Do While fName <> ""
            Set wb = Workbooks.Open(fPath & "\" & fName)
                wb.Sheets(1).Range("E2").Copy sh.Cells(Rows.Count, 4).End(xlUp)(3)
                sh.Cells(Rows.Count, 1).End(xlUp).Offset(, 3) = fPath
                wb.Close False
                fName = Dir
        Loop
End Sub

I wondered if you had any ideas how to fix this at all as it's erroring when I try to run it?

Thanks again!

 

[JLGWhiz]

If you want file names in column c then:

sh.Cells(Rows.Count, 4).End(xlUp).Offset(, -1) = fName

put this after the copy statement for E2.

 

[JLGWhiz]

The losgic used to locate the cells for entering copied data and the path and file name is pretty simple. For the copy and paste, find the last cell with data in the column where you want to paste the data. That is done with the Rows.Count and End(xlUp) statement which tells VBA to go to the bottom of the column and look upward until it finds data, then offset to the appropriate row below. Then to put the other two pieces of data on the correct row, just use the same technique keyed on the original cell that had data pasted into it, but offset to the left or right as applicable to the appropriate column. What you did not specifiy in the OP was that you were skipping rows, and you also started by copying from column A of the source sheet to column A of the destination sheet. It would make it easier for us to help you if you put accurate and complete information in your original post.

 

[Cuzzaa]

If you want file names in column c then:

sh.Cells(Rows.Count, 4).End(xlUp).Offset(, -1) = fName

put this after the copy statement for E2.

Thanks so much! This is perfect and your explanation was also very enlightening so thank you.

Also I appreciate what you're saying - sorry, at the time of the OP I was importing everything into A1 but then later down the line I changed things. I also don't mean to be skipping a line each time, that just happened while I was testing and I couldn't work out how to fix it.

Here is my current working code:

Sub ImportChannels()

Dim fPath As String, fName As String, wb As Workbook, sh As Worksheet
Set sh = ActiveSheet
With Application.FileDialog(msoFileDialogFolderPicker)
    .Show
    fPath = .SelectedItems(1)
End With
    fName = Dir(fPath & "\" & "*.csv")
        Do While fName <> ""
            Set wb = Workbooks.Open(fPath & "\" & fName)
                wb.Sheets(1).Range("E2").Copy sh.Cells(Rows.Count, 4).End(xlUp)(3)
                sh.Cells(Rows.Count, 4).End(xlUp).Offset(, -1) = fName
                sh.Cells(Rows.Count, 1).End(xlUp).Offset(, 3) = fPath
                wb.Close False
                fName = Dir
        Loop
 
 Range("B10").Select
 
  With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0.399975585192419
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -1
    End With
    Selection.Font.Bold = True
 
Range("A1").Select

MsgBox "Channels successfully imported!", vbInformation

End Sub

Can I ask one final question to complete my objective, maybe I'm pushing my luck so tell me if so but is there is a relatively simple way to achieve the following?

The above macro pulls in the value of cell E2 from each and every .csv file from the directory selected and prints into my active sheet from columns D14, D16, D18, D20 etc. In the same row for each of these but in column G, I then set a custom value against each of these (can be a positive or negative number) and these can be different to the other rows, so for example for in D16, I have 24 entered in G16.

I then am trying to make a 2nd button (after running the code above) using vba that when clicked then automatically opens up the first file that was imported and then adds the value typed in G16 (in the active sheet) to the value in cell F2 (imported spreadsheet) and does this for the entirety of column F that contains a value in this column (stops at the first blank cell it finds in column F).

I would then like to loop the above process for all .csv files found when importing the directory using the first button. Note that when the .csv files are opened and we are updating column F2 it is important that the file is not overwritten but a copy of the spreadsheet is made with the applied changes (in the same directory).

Appreciate this may be a lengthy difficult task to help me with this but any advice would be greatly appreciated and would be very helpful.

Thanks as always.