请求编写Excel VBA代码：复制Submissions上方单元格粘贴至Totals下方并循环

Got it, let's get this sorted for you! It sounds like your existing code only grabs the first match because it's missing a loop to keep hunting for subsequent "Submissions" and "Totals" pairs. Below is a fully commented VBA macro that will handle every group in your worksheet, with safeguards to avoid errors.

Sub CopySubmissionHeaderToTotals()
    Dim ws As Worksheet
    Dim submissionCell As Range
    Dim totalCell As Range
    Dim searchStart As Range
    
    ' Set your target worksheet (replace "Sheet1" with your actual tab name)
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    ' Start searching from the top-left cell of the used range
    Set searchStart = ws.Cells(1, 1)
    
    ' Loop through every instance of "Submissions"
    Do
        ' Find the next "Submissions" cell, starting after the last one we found
        Set submissionCell = ws.Cells.Find( _
            What:="Submissions", _
            After:=searchStart, _
            LookIn:=xlValues, _
            LookAt:=xlWhole, ' Use xlPart if you want partial matches
            SearchOrder:=xlByRows)
        
        ' Exit the loop if we can't find any more "Submissions"
        If submissionCell Is Nothing Then Exit Do
        
        ' Make sure we don't try to copy from row 1 (no cell above!)
        If submissionCell.Row > 1 Then
            ' Find the "Totals" that comes AFTER this "Submissions"
            Set totalCell = ws.Cells.Find( _
                What:="Totals", _
                After:=submissionCell, _
                LookIn:=xlValues, _
                LookAt:=xlWhole, _
                SearchOrder:=xlByRows)
            
            ' Only proceed if we found a matching "Totals"
            If Not totalCell Is Nothing Then
                ' Copy the cell directly above "Submissions"
                submissionCell.Offset(-1, 0).Copy
                
                ' Paste to the cell directly below "Totals"
                ' Use xlPasteAll instead if you want to copy formatting too
                totalCell.Offset(1, 0).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                
                ' Clear the clipboard to get rid of the "marching ants" selection
                Application.CutCopyMode = False
            End If
        End If
        
        ' Move the search start to the cell after the current "Submissions"
        ' This ensures we don't keep re-finding the same cell
        Set searchStart = submissionCell.Offset(1, 0)
    Loop
End Sub

How to Use This Code: #

1. Open your Excel file
2. Press Alt + F11 to open the VBA Editor
3. Right-click your workbook in the Project Explorer (left pane) → select Insert → Module
4. Paste the code into the new module window
5. Replace "Sheet1" with the actual name of your worksheet (the tab name at the bottom of Excel)
6. Press F5 to run the macro, or assign it to a button in your worksheet for easier access

Key Notes: #

• Exact vs Partial Matches: The code uses xlWhole to find exact matches of "Submissions" and "Totals". If you need to match cells that contain these words (e.g., "Q3 Submissions"), change xlWhole to xlPart.
• Case Sensitivity: By default, the Find method ignores case. If you need it to be case-sensitive (e.g., only match "Submissions" not "submissions"), add MatchCase:=True to both Find calls.
• Column-Specific Search: If your keywords are only in a specific column (e.g., column A), replace ws.Cells.Find with ws.Columns("A:A").Find to narrow down the search range.

内容的提问来源于stack exchange，提问作者user_needhelp