title: Excel VBA Cycle For
body: <p>I have a file named <code>vegetables_fruits</code> and 4 other files : <code>apple</code>, <code>banana</code>, <code>tomato</code>, <code>cucumber</code>. In the file <code>vegetables_fruits</code> I have a Worksheet named <code>List</code> where I fold the names of all 4 files (ex., cell <code>A2 = apple</code>,  cell <code>A3 = banana</code>, cell <code>A4 = tomato</code>, cell <code>A5 = cucumber</code>). In addition to the sheet <code>List</code> I have sheets <code>banana</code>, <code>tomato</code> and <code>cucumber</code>, but I don't have <code>apple</code>. </p>
  
  <p>It's necessary to paste the <code>column A</code> from each of this 4 files to every sheet in the <code>vegetables_fruits</code> (ex., from file <code>apple</code> it's necessary to copy <code>column A</code> to file "vegetables_fruits" to sheet "banane" ; from file "banana" it's necessary to copy <code>column A</code> to file <code>vegetables_fruits</code> to sheet <code>tomato</code> etc.) Thank you very much for your help!</p>
  
  <p>P.S. It needs to create a For, but I don't know how I can decribe all of this conditions.</p>
  
  <pre><code>Sub CopyPaste()
  
  Dim r As Variant
  Dim a As Variant
  Dim b As Integer
  Dim nbcells As Integer
  Dim ws As Worksheet
  
  Worksheets("List").Activate
  nbcells = Application.WorksheetFunction.CountA(Range("A2:A" &amp; Range("A65536").End(xlUp).Row))
  
  ' === Create a new sheet ===
  For r = 2 To nbcells
      Sheets.Add After:=Sheets(Sheets.Count - 1)
      Worksheets(r).Name = Worksheets("List").Cells(r + 1, 1).Value
  Next r
  
  ' === DATA ===
  For Each ws In Sheets
      If ws.Name Like "*.xls*" Then
          For a = 2 To nbcells
                      Windows(a).Activate
                      Range("B:B").SpecialCells(2).Copy
                      Workbooks("vegetables_fruits.xlsm").Activate
                          b = a + 1
                          If ws.Name = Worksheets("List").Cells(b, 1).Value Then
                              ws.Select
                              Range("A2").Select
                              ActiveSheet.Paste
                          End If
                  Next a
      End If
  Next
  
  End Sub
  </code></pre>