SOLVED
Home

VBA code to either copy/paste or reference a single cell ("AF2") from every wookbook in a folder

%3CLINGO-SUB%20id%3D%22lingo-sub-837551%22%20slang%3D%22en-US%22%3EVBA%20code%20to%20either%20copy%2Fpaste%20or%20reference%20a%20single%20cell%20(%22AF2%22)%20from%20every%20wookbook%20in%20a%20folder%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-837551%22%20slang%3D%22en-US%22%3E%3CDIV%3E%3CFONT%3EHello%20all%2C%20%3C%2FFONT%3EI'm%20fairly%20new%20to%20VBA%20and%20don't%20quite%20know%20all%20of%20its%20allowances%20and%20constraints%20yet%20so%20please%20bear%20with%20me.%20As%20part%20of%20another%20script%2C%20I've%20calculated%20the%20total%20sum%20of%20a%20column%20(%22AD%22)%20in%20cell%20%22AF2%22%20of%20every%20workbook%20within%20a%20folder.%20Each%20workbook%20contains%20only%20one%20worksheet.%20What%20I%20am%20trying%20to%20do%20is%20either%20copy%2Fpaste%20or%20reference%20each%20total%20from%20each%20book%20in%20a%20separate%20row%20of%20a%20new%20sheet%2C%20where%20I%20will%20then%20take%20the%20grand%20total.%20Below%20I%20have%20the%20code%20that%20I%20used%20to%20iterate%20through%20each%20workbook%20in%20the%20folder%20using%20my%20first%20script.%20I%20know%20I%20should%20have%20done%20this%20all%20at%20the%20same%20time%20to%20save%20excel%20the%20trouble%20opening%2Fclosing%20files%2C%20but%20this%20was%20just%20asked%20of%20me%20and%20I'm%20not%20quite%20sure%20how%20to%20approach%20the%20problem.%20Any%20ideas%20(is%20a%20simple%20activecell.offset(1%2C0)%20required%2C%20or%20something%20more)%3F%20Thanks%20in%20advance!%3C%2FDIV%3E%3CDIV%3E%26nbsp%3B%3C%2FDIV%3E%3CDIV%3E%3CFONT%3ESub%20GRABTOTAL()%3CBR%20%2F%3E%26nbsp%3B%26nbsp%3B%26nbsp%3B%20Dim%20xFd%20As%20FileDialog%3CBR%20%2F%3E%26nbsp%3B%26nbsp%3B%26nbsp%3B%20Dim%20xFdItem%20As%20Variant%3CBR%20%2F%3E%26nbsp%3B%26nbsp%3B%26nbsp%3B%20Dim%20xFileName%20As%20String%3CBR%20%2F%3E%26nbsp%3B%26nbsp%3B%26nbsp%3B%20Set%20xFd%20%3D%20Application.FileDialog(msoFileDialogFolderPicker)%3CBR%20%2F%3E%26nbsp%3B%26nbsp%3B%26nbsp%3B%20If%20xFd.Show%20%3D%20-1%20Then%3CBR%20%2F%3E%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%20xFdItem%20%3D%20xFd.SelectedItems(1)%20%26amp%3B%20Application.PathSeparator%3CBR%20%2F%3E%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%20xFileName%20%3D%20Dir(xFdItem%20%26amp%3B%20%22*.csv*%22)%3CBR%20%2F%3E%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%20Do%20While%20xFileName%20%26lt%3B%26gt%3B%20%22%22%3CBR%20%2F%3E%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%20With%20Workbooks.Open(xFdItem%20%26amp%3B%20xFileName)%3CBR%20%2F%3E%26nbsp%3B%20%26nbsp%3B%20%26nbsp%3B%20%26nbsp%3B%20%26nbsp%3B%20%26nbsp%3B%20%26nbsp%3B%20%26nbsp%3B%20%26nbsp%3B%20%26nbsp%3B%20%26nbsp%3B%20%26nbsp%3B%3CBR%20%2F%3E%3CBR%20%2F%3E%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%20ActiveWorkbook.Save%3CBR%20%2F%3E%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%20ActiveWorkbook.Close%3CBR%20%2F%3E%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%20End%20With%3CBR%20%2F%3E%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%20xFileName%20%3D%20Dir%3CBR%20%2F%3E%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%26nbsp%3B%20Loop%3CBR%20%2F%3E%26nbsp%3B%26nbsp%3B%26nbsp%3B%20End%20If%3CBR%20%2F%3EEnd%20Sub%3C%2FFONT%3E%3C%2FDIV%3E%3CDIV%3E%26nbsp%3B%3C%2FDIV%3E%3C%2FLINGO-BODY%3E%3CLINGO-LABS%20id%3D%22lingo-labs-837551%22%20slang%3D%22en-US%22%3E%3CLINGO-LABEL%3EExcel%3C%2FLINGO-LABEL%3E%3CLINGO-LABEL%3EMacros%20and%20VBA%3C%2FLINGO-LABEL%3E%3C%2FLINGO-LABS%3E%3CLINGO-SUB%20id%3D%22lingo-sub-837810%22%20slang%3D%22en-US%22%3ERe%3A%20VBA%20code%20to%20either%20copy%2Fpaste%20or%20reference%20a%20single%20cell%20(%22AF2%22)%20from%20every%20wookbook%20i%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-837810%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F398570%22%20target%3D%22_blank%22%3E%40myfavoritecoloris%3C%2FA%3E%26nbsp%3B%3C%2FP%3E%3CP%3EYou%20may%20tweak%20your%20code%20like%20this...%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CPRE%20class%3D%22lia-code-sample%20language-markup%22%3E%3CCODE%3ESub%20GRABTOTAL()%0A%20%20%20%20Dim%20xFd%20As%20FileDialog%0A%20%20%20%20Dim%20xFdItem%20As%20Variant%0A%20%20%20%20Dim%20xFileName%20As%20String%0A%20%20%20%20Dim%20startRow%20As%20Long%0A%20%20%20%20Dim%20wbSource%20As%20Workbook%0A%20%20%20%20Dim%20wbDest%20As%20Workbook%0A%20%20%20%20Dim%20wsDest%20As%20Worksheet%0A%20%20%20%20%0A%20%20%20%20Application.ScreenUpdating%20%3D%20False%0A%20%20%20%20%0A%20%20%20%20Set%20wbDest%20%3D%20ThisWorkbook%20%20%20'The%20Workbook%20which%20contains%20this%20Macro%0A%20%20%20%20%0A%20%20%20%20Set%20wsDest%20%3D%20wbDest.Worksheets.Add(before%3A%3DwbDest.Worksheets(1))%20%20%20%20'Sheet%20will%20be%20added%20to%20write%20the%20values%20from%20all%20the%20csv%20files%0A%20%20%20%20wsDest.Range(%22A1%22).Value%20%3D%20%22Totals%22%0A%20%20%20%20startRow%20%3D%202%20%20%20%20'Write%20the%20values%20in%20column%20A%20starting%20from%20Row2%0A%20%20%20%20%0A%20%20%20%20Set%20xFd%20%3D%20Application.FileDialog(msoFileDialogFolderPicker)%0A%20%20%20%20If%20xFd.Show%20%3D%20-1%20Then%0A%20%20%20%20%20%20%20%20xFdItem%20%3D%20xFd.SelectedItems(1)%20%26amp%3B%20Application.PathSeparator%0A%20%20%20%20%20%20%20%20xFileName%20%3D%20Dir(xFdItem%20%26amp%3B%20%22*.csv*%22)%0A%20%20%20%20%20%20%20%20Do%20While%20xFileName%20%26lt%3B%26gt%3B%20%22%22%0A%20%20%20%20%20%20%20%20%20%20%20%20Set%20wbSource%20%3D%20Workbooks.Open(xFdItem%20%26amp%3B%20xFileName)%0A%20%20%20%20%20%20%20%20%20%20%20%20%0A%20%20%20%20%20%20%20%20%20%20%20%20'Fetchnig%20the%20value%20from%20cell%20AF2%20in%20column%20A%20of%20the%20newly%20added%20Sheet%20in%20this%20Workbook%0A%20%20%20%20%20%20%20%20%20%20%20%20wsDest.Range(%22A%22%20%26amp%3B%20startRow).Value%20%3D%20wbSource.Worksheets(1).Range(%22AF2%22).Value%0A%20%20%20%20%20%20%20%20%20%20%20%20%0A%20%20%20%20%20%20%20%20%20%20%20%20wbSource.Close%20False%20%20%20%20'Closing%20the%20csv%20file%20without%20saving%0A%20%20%20%20%20%20%20%20%20%20%20%20%0A%20%20%20%20%20%20%20%20%20%20%20%20startRow%20%3D%20startRow%20%2B%201%20'Incrementing%20the%20row%20by%201%0A%20%20%20%20%20%20%20%20%20%20%20%20%0A%20%20%20%20%20%20%20%20%20%20%20%20xFileName%20%3D%20Dir%0A%20%20%20%20%20%20%20%20Loop%0A%20%20%20%20End%20If%0A%20%20%20%20Application.ScreenUpdating%20%3D%20True%0AEnd%20Sub%3C%2FCODE%3E%3C%2FPRE%3E%3C%2FLINGO-BODY%3E
myfavoritecoloris
Frequent Visitor
Hello all, I'm fairly new to VBA and don't quite know all of its allowances and constraints yet so please bear with me. As part of another script, I've calculated the total sum of a column ("AD") in cell "AF2" of every workbook within a folder. Each workbook contains only one worksheet. What I am trying to do is either copy/paste or reference each total from each book in a separate row of a new sheet, where I will then take the grand total. Below I have the code that I used to iterate through each workbook in the folder using my first script. I know I should have done this all at the same time to save excel the trouble opening/closing files, but this was just asked of me and I'm not quite sure how to approach the problem. Any ideas (is a simple activecell.offset(1,0) required, or something more)? Thanks in advance!
 
Sub GRABTOTAL()
    Dim xFd As FileDialog
    Dim xFdItem As Variant
    Dim xFileName As String
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show = -1 Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
        xFileName = Dir(xFdItem & "*.csv*")
        Do While xFileName <> ""
            With Workbooks.Open(xFdItem & xFileName)
                       

            ActiveWorkbook.Save
            ActiveWorkbook.Close
            End With
            xFileName = Dir
        Loop
    End If
End Sub
 
1 Reply
Solution

@myfavoritecoloris 

You may tweak your code like this...

 

Sub GRABTOTAL()
    Dim xFd As FileDialog
    Dim xFdItem As Variant
    Dim xFileName As String
    Dim startRow As Long
    Dim wbSource As Workbook
    Dim wbDest As Workbook
    Dim wsDest As Worksheet
    
    Application.ScreenUpdating = False
    
    Set wbDest = ThisWorkbook   'The Workbook which contains this Macro
    
    Set wsDest = wbDest.Worksheets.Add(before:=wbDest.Worksheets(1))    'Sheet will be added to write the values from all the csv files
    wsDest.Range("A1").Value = "Totals"
    startRow = 2    'Write the values in column A starting from Row2
    
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show = -1 Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
        xFileName = Dir(xFdItem & "*.csv*")
        Do While xFileName <> ""
            Set wbSource = Workbooks.Open(xFdItem & xFileName)
            
            'Fetchnig the value from cell AF2 in column A of the newly added Sheet in this Workbook
            wsDest.Range("A" & startRow).Value = wbSource.Worksheets(1).Range("AF2").Value
            
            wbSource.Close False    'Closing the csv file without saving
            
            startRow = startRow + 1 'Incrementing the row by 1
            
            xFileName = Dir
        Loop
    End If
    Application.ScreenUpdating = True
End Sub
Related Conversations
Tabs and Dark Mode
cjc2112 in Discussions on
46 Replies
Stable version of Edge insider browser
HotCakeX in Discussions on
35 Replies
flashing a white screen while open new tab
Deleted in Discussions on
14 Replies
Security Community Webinars
Valon_Kolica in Security, Privacy & Compliance on
13 Replies
How to Prevent Teams from Auto-Launch
chenrylee in Microsoft Teams on
29 Replies