VBA nested loop getting stuck at copying a cell

Question

I made the following VBA code, the idea is to first loop through an entire folder with CSV files, and in each one of those inserts, in cell A1, a value coming from a "master" file, from which the macro is being run. The code looks like this.

Sub AllWorkbooks()
   Dim MyFolder As String 'Path collected from the folder picker dialog
   Dim MyFile As String 'Filename obtained by DIR function
   Dim wbk As Workbook 'Used to loop through each workbook
On Error Resume Next
Application.ScreenUpdating = False
'Opens the folder picker dialog to allow user selection
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Please select a folder"
.Show
.AllowMultiSelect = False
   If .SelectedItems.Count = 0 Then 'If no folder is selected, abort
MsgBox "You did not select a folder"
      Exit Sub
   End If
MyFolder = .SelectedItems(1) & "\" 'Assign selected folder to MyFolder
End With
MyFile = Dir(MyFolder & "*.csv", vbNormal) 'DIR gets the first file of the folder
'Loop through all files in a folder until DIR cannot find anymore
Do While MyFile <> ""
   'Opens the file and assigns to the wbk variable for future use
   Set wbk = Workbooks.Open(Filename:=MyFolder & MyFile)
   'Replace the line below with the statements you would want your macro to perform
   Windows("master.xlsm").Activate
   Dim c As Range
   For Each c In ActiveSheet.Range("A1:A2000")
        wbk.Activate
        Sheets(1).Range("a1").Value = c
        wbk.Close savechanges:=True
        Exit For
    Next
MyFile = Dir 'DIR gets the next file in the folder
Loop
Application.ScreenUpdating = True
End Sub

I followed the step-by-step process of the macro and the issue seems to come from this block

 Windows("master.xlsm").Activate


  Dim c As Range
   For Each c In ActiveSheet.Range("A1:A2000")
        wbk.Activate
        Sheets(1).Range("a1").Value = c
        wbk.Close savechanges:=True
        Exit For
    Next

For some reason, the macro is just copying the first value of the master file in all the CSV files... It most likely is something easy to solve but I have very little knowledge of VBA and I can't find a way to make it work.

Thanks for any suggestion or help.

[THIS](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) will solve youre issue... — Siddharth Rout, Nov 06 '22 at 18:57
`Exit For` is breaking out of the loop after a single cell was written to A1... — Mathieu Guindon, Nov 07 '22 at 01:05

score 0 · Answer 1 · answered Nov 07 '22 at 03:03

Loop Through Files to Write to Them

A Quick Fix

Sub AllWorkbooks()
    
    Dim MyFolder As String 'Path collected from the folder picker dialog
    Dim MyFile As String 'Filename obtained by DIR function
    
    Application.ScreenUpdating = False

    'Opens the folder picker dialog to allow user selection
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Please select a folder"
        .Show
        '.AllowMultiSelect = False ' no need, you cannot select more than one
        If .SelectedItems.Count = 0 Then 'If no folder is selected, abort
            MsgBox "You did not select a folder"
            Exit Sub
        End If
        MyFolder = .SelectedItems(1) & "\" 'Assign selected folder to MyFolder
    End With
    
    MyFile = Dir(MyFolder & "*.csv", vbNormal) 'DIR gets the first file of the folder
    If MyFile = "" Then
        MsgBox "No CSV files found.", vbCritical
        Exit Sub
    End If
    
    ' Source ("Master.xlsm")
    Dim swb As Workbook: Set swb = ThisWorkbook ' workbook containing this code
    Dim sws As Worksheet: Set sws = swb.Worksheets("Sheet1") ' adjust!

    ' Destination
    Dim dwb As Workbook
    Dim dws As Worksheet

    'Loop through all files in a folder until DIR cannot find anymore
    Do While MyFile <> ""
        Set dwb = Workbooks.Open(Filename:=MyFolder & MyFile)
        Set dws = dwb.Worksheets(1) ' the one and only
        dws.Range("A1:A2000").Value = sws.Range("A1:A2000").Value
        dwb.Close SaveChanges:=True
        
        MyFile = Dir 'DIR gets the next file in the folder
    Loop

    Application.ScreenUpdating = True

    MsgBox "Column copied to all files.", vbInformation

End Sub

VBA nested loop getting stuck at copying a cell

1 Answers1

Loop Through Files to Write to Them