Forum Discussion

myfavoritecoloris's avatar
myfavoritecoloris
Copper Contributor
Sep 04, 2019
Solved

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

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
 
excel
Macros and VBA
  • Subodh_Tiwari_sktneer's avatar
    Subodh_Tiwari_sktneer
    Sep 05, 2019

    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

1 Reply

  • Subodh_Tiwari_sktneer's avatar
    Subodh_Tiwari_sktneer
    Silver Contributor
    Sep 05, 2019

    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

Resources