CODEWITHSUNDEEP
excelvbacopy
Julia Linney
Julia Linney

Reputation: 1

Copy some cells from a worksheet to another

I'm trying to run a code that will scroll through a folder and list all the files within the folder. I then want to copy a few cells from a worksheet in each file (the files are all identical) and put the values into my activesheet in the row each filename appears on.

Here is my code so far - it works to loop through all files within the folder and list their FileName and DateModified. I am stuck on being able to select some cells from the first sheet on each File and copy them into my activesheet.

Sub UpdateLog()

'Set a reference to Microsoft Scripting Runtime by using
'Tools > References in the Visual Basic Editor (Alt+F11)

'Declare the variables


    
Dim objFSO As FileSystemObject
Dim objFolder As Folder
Dim objFile As File
Dim strPath As String
Dim strFile As String
Dim NextRow As Long


'Specify the path to the folder
strPath = "C:\Users\julia\Forms"

'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")

'Get the folder
Set objFolder = objFSO.GetFolder(strPath)

'If the folder does not contain files, exit the sub
If objFolder.Files.Count = 0 Then
    MsgBox "No files were found...", vbExclamation
    Exit Sub
End If

'Turn off screen updating
Application.ScreenUpdating = False

   
'Find the next available row
NextRow = Cells(Rows.Count, "A").End(xlUp).Row + 4

'Loop through each file in the folder
For Each objFile In objFolder.Files

    'List the name and date/time of the current file
    Cells(NextRow, 2).Value = objFile.Name
    Cells(NextRow, 3).Value = objFile.DateLastModified

this is where I would then like to include some information from each of the files in my active sheet

I tried doing Cells(NextRow, 4).Value = objFile.Worksheet("Front Sheet").Range("E6").Copy

But I am already thinking this is very long winded and does not work. I think I need to open the file, reference it and then select the cells I want to copy as a range.

I could maybe then use copyrange and destination range? I'm not really sure how to do this though.

   NextRow = NextRow + 1

Next objFile

'Change the width of the columns to achieve the best fit
'Columns.AutoFit

'Turn screen updating back on
Application.ScreenUpdating = True

End Sub

Upvotes: 0

Views: 35

Answers (1)

k1dr0ck
k1dr0ck

Reputation: 1215

try

Sub LoopThroughFiles()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    Dim folderPath As String
    Dim file As String
    Dim row As Long
    
    'Get folder path
    folderPath = "C:\Users\julia\Forms"
    
    'Get last row of column A
    row = Cells(Rows.Count, "A").End(xlUp).row + 4
    
    'Loop through all files in folder path
    file = Dir(folderPath & "\*.xlsx")
    Do While file <> ""
        
        'Write file name to column A
        Cells(row, "A").value = file
        
        'Write date modified to column B
        Cells(row, "B").value = FileDateTime(folderPath & "\" & file)
        
        'Open file and retrieve value in cell E6 of worksheet "Front Sheet"
        Dim wb As Workbook
        Set wb = Workbooks.Open(folderPath & "\" & file)
        Cells(row, "C").value = wb.Worksheets("Front Sheet").Range("E6").value
        wb.Close
                
        'Move to next row
        row = row + 1
        
        'Get next file
        file = Dir
    Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "Copy complete"
End Sub

Upvotes: 0

Related Questions