我需要 For Each 循环吗？

Question

For Each 循环是动态选择范围并将其粘贴到不同工作表中的目标单元格的顺序列表中的方法吗？我想找到一种方法来循环这个过程。

我的流程选择电子表格的一部分，然后将其复制到另一个电子表格。然后重复。我觉得它应该变成某种循环，但找不到答案。

Sub CopyStations()

     
    'select the last non-blank cell in column A
    Sheets("Report").Select
    Cells(Rows.Count, "A").End(xlUp).Offset(-9, 0).Select
        Range(Selection, Selection.End(xlUp)).Select

    
    
    numRows = Selection.Rows.Count - 3
    Selection.Resize(numRows - 0, 9).Select
    Selection.Offset(3, 0).Select
    
  'milk and condiments
     Selection.Copy
    Sheets("Formula Sheet").Select
    Range("A196").Select
    ActiveSheet.Paste
    Sheets("Report").Select
    
          Application.CutCopyMode = False
   
' Find first cell in next range


    Selection.End(xlUp).Select
    Selection.End(xlUp).Select

    Range(Selection, Selection.End(xlUp)).Select

    
    
        numRows = Selection.Rows.Count - 3
    Selection.Resize(numRows - 0, 9).Select
    Selection.Offset(3, 0).Select
    
   'fruit and veggies
   Selection.Copy
    Sheets("Formula Sheet").Select
    Range("A168").Select
    ActiveSheet.Paste
    Sheets("Report").Select
    
          Application.CutCopyMode = False
          
    ' Find first cell in next range


    Selection.End(xlUp).Select
    Selection.End(xlUp).Select

    Range(Selection, Selection.End(xlUp)).Select
'next part
    
    
        numRows = Selection.Rows.Count - 3
    Selection.Resize(numRows - 0, 9).Select
    Selection.Offset(3, 0).Select
    
   'on the go
   Selection.Copy
    Sheets("Formula Sheet").Select
    Range("A141").Select
    ActiveSheet.Paste
    Sheets("Report").Select
    
          Application.CutCopyMode = False
          
          ' Find first cell in next range

'
    Selection.End(xlUp).Select
    Selection.End(xlUp).Select

    Range(Selection, Selection.End(xlUp)).Select

    
    
        numRows = Selection.Rows.Count - 3
    Selection.Resize(numRows - 0, 9).Select
    Selection.Offset(3, 0).Select
    
   'sono
   Selection.Copy
    Sheets("Formula Sheet").Select
    Range("A98").Select
    ActiveSheet.Paste
    Sheets("Report").Select
    
          Application.CutCopyMode = False
          
' Find first cell in next range

'
    Selection.End(xlUp).Select
    Selection.End(xlUp).Select

    Range(Selection, Selection.End(xlUp)).Select
'next part
    
    
        numRows = Selection.Rows.Count - 3
    Selection.Resize(numRows - 0, 9).Select
    Selection.Offset(3, 0).Select
    
   '2mato
   Selection.Copy
    Sheets("Formula Sheet").Select
    Range("A120").Select
    ActiveSheet.Paste
    Sheets("Report").Select
    
          Application.CutCopyMode = False
          
          
' Find first cell in next range


    Selection.End(xlUp).Select
    Selection.End(xlUp).Select

    Range(Selection, Selection.End(xlUp)).Select

    
    
        numRows = Selection.Rows.Count - 3
    Selection.Resize(numRows - 0, 9).Select
    Selection.Offset(3, 0).Select
    
   'roost
   Selection.Copy
    Sheets("Formula Sheet").Select
    Range("A54").Select
    ActiveSheet.Paste
    Sheets("Report").Select
    
          Application.CutCopyMode = False
          
    ' Find first cell in next range
    
        Selection.End(xlUp).Select
    Selection.End(xlUp).Select

    Range(Selection, Selection.End(xlUp)).Select

    
    
        numRows = Selection.Rows.Count - 3
    Selection.Resize(numRows - 0, 9).Select
    Selection.Offset(3, 0).Select
    
   'grill
   Selection.Copy
    Sheets("Formula Sheet").Select
    Range("A76").Select
    ActiveSheet.Paste
    Sheets("Report").Select
    
          Application.CutCopyMode = False
    
    
    
    
    ' the last range to paste into


    Selection.End(xlUp).Select
    Selection.End(xlUp).Select

    Range(Selection, Selection.End(xlUp)).Select
'
    
    
        numRows = Selection.Rows.Count - 3
    Selection.Resize(numRows - 0, 9).Select
    Selection.Offset(3, 0).Select
    
   
   Selection.Copy
    Sheets("Formula Sheet").Select
    Range("A38").Select
    ActiveSheet.Paste
  
    
          Application.CutCopyMode = False
          

    Range("A:38").Select


          
End Sub

附注我知道“选择”是不受欢迎的，但这就是您作为等级初学者处理录制的宏时所得到的结果。

Answer 1

改进宏记录器代码

Option Explicit

Sub CopyStations()

    ' Return the destination cell addresses in an array.
    Dim dCellAddresses() As Variant: dCellAddresses = Array( _
        "A196", "A168", "A141", "A98", "A120", "A54", "A76", "A38")

    ' Reference the workbook.
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Reference the worksheets.
    Dim sws As Worksheet: Set sws = wb.Sheets("Report") ' copy (read)
    Dim dws As Worksheet: Set dws = wb.Sheets("Formula Sheet") ' paste (write)

    ' Define additional variables.
    Dim srg As Range, scell As Range, dcell As Range
     
    ' Reference the last (bottom-most) non-empty cell in column 'A'
    Set scell = sws.Cells(sws.Rows.Count, "A").End(xlUp)
    ' Exclude 9 bottom-most cells to reference the last cell in column 'A'
    ' of the last section (for the first destination cell).
    Set scell = scell.Offset(-9)
    
    ' Loop through the sections in the source sheet (or the destination cells).
    For c = LBound(dCellAddresses) To UBound(dCellAddresses)
        ' Go up to reference the range ('section') in column 'A'.
        Set srg = Range(scell.End(xlUp), scell)
        ' Exclude the first 3 rows and resize to 9 columns.
        Set srg = srg.Resize(srg.Rows.Count - 3, 9).Offset(3)
        ' Reference the destination cell.
        Set dcell = dws.Range(dCellAddresses(c))
        ' Copy.
        srg.Copy dcell
        ' Reference the source last cell in column 'A' of the previous section.
        Set scell = srg.Cells(1).End(xlUp)
    Next c
          
End Sub