Excel VBA循环用于

Question

我有一个文件，名为vegetables_fruits和4个其他文件：apple,banana,tomato,cucumber。在文件vegetables_fruits我有一个名为List的工作表，其中我折叠所有4个文件的名称（例如，单元格A2 = apple，单元格A3 = banana，单元格A4 = tomato，单元格A5 = cucumber）。除表List我有床单banana,tomato和cucumber，但我没有apple。

因此，有必要从各个这4个文件的column A粘贴到每片在vegetables_fruits（例如，从文件apple有必要复制column A到文件“vegetables_fruits”到工作表“banane”;从文件“香蕉”有必要将column A复制到vegetables_fruits文件tomato等）非常感谢您的帮助！

P.S.它需要创建一个For，但我不知道如何描述所有这些条件。

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" & 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 

Answer 1

玛丽亚 - 读你的问题，我认为你需要额外的逻辑如下：

1. 假设所有工作簿是开放的，并有适当的名称。
2. 循环遍历所有的工作簿。
3. 如果我找到一个包含我的定义名称的工作簿，然后从该工作簿中的某个工作簿中复制列A
4. 将其粘贴到主工作簿中的相应名称的工作表上。

对于我的示例，您需要将这些变量添加到声明变量的部分。

Dim fromWS As Worksheet, toWS As Worksheet 
Dim wb As Workbook, myWB As Workbook 

在代码早期，靠近顶部，您将需要这行代码。

Set myWB = ActiveWorkbook 

稍后在代码中，这个循环和case语句将完成上述逻辑...

For Each wb In Workbooks 
    Select Case wb.Name 
     Case "apple" 
      Set fromWS = wb.Worksheets("Sheet1") '<~~ put your sheet name here 
      Set toWS = myWB.Worksheets("apple") 
     Case "banana" 
      Set fromWS = wb.Worksheets("Sheet1") '<~~ put your sheet name here 
      Set toWS = myWB.Worksheets("banana") 
     Case "tomato" 
      Set fromWS = wb.Worksheets("Sheet1") '<~~ put your sheet name here 
      Set toWS = myWB.Worksheets("tomato") 
     Case "cucumber" 
      Set fromWS = wb.Worksheets("Sheet1") '<~~ put your sheet name here 
      Set toWS = myWB.Worksheets("cucumber") 
     Case Else 
    End Select 
    fromWS.Range("A:A").Copy toWS.Range("A:A") 
Next wb 

请您谈一下有没有作为一个“苹果”片。这是您可能需要为其构建异常逻辑的细微差别。 （例如，在上面的循环中省略该情况）