Excel需求：将Sheet1指定行数据复制5次到Sheet2直至空行

Hey there, let's get this sorted out! It sounds like your current code is stuck repeating just the first row because the loop logic isn't properly moving through Sheet1's rows or handling the 5x paste per row correctly. Let's break down the solution step by step.

First, let's diagnose the common pitfalls #

Most likely, your original code either:

• Doesn't increment the source row number after processing the first line, so it keeps copying the same row over and over
• Fails to nest the "paste 5 times" loop inside the main row-processing loop, leading to only one row being handled

Here's the corrected, robust code #

This will loop through every non-empty row starting at A2:C2 in Sheet1, paste each row 5 times in Sheet2, and stop when it hits an empty row in Sheet1:

Sub CopyRowsMultipleTimes()
    Dim wsSource As Worksheet
    Dim wsDest As Worksheet
    Dim rowSource As Long
    Dim rowDest As Long
    Dim i As Integer
    
    ' Set direct references to your worksheets (avoids relying on active sheets)
    Set wsSource = ThisWorkbook.Sheets("Sheet1")
    Set wsDest = ThisWorkbook.Sheets("Sheet2")
    
    ' Initialize starting positions
    rowSource = 2 ' Start at the first data row (A2:C2) in Sheet1
    rowDest = 1 ' Start pasting at the top of Sheet2 (adjust to 2 if you need a header)
    
    ' Speed up execution and prevent screen flicker
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    ' Loop until we hit an empty cell in column A of Sheet1
    Do While wsSource.Cells(rowSource, "A").Value <> ""
        ' Paste the current source row 5 times into Sheet2
        For i = 1 To 5
            ' Copy the A:C range of the current source row
            wsSource.Range("A" & rowSource & ":C" & rowSource).Copy _
                Destination:=wsDest.Range("A" & rowDest)
            ' Move to the next empty row in Sheet2 for the next paste
            rowDest = rowDest + 1
        Next i
        
        ' Move to the next row in Sheet1 to process the next set of data
        rowSource = rowSource + 1
    Loop
    
    ' Restore Excel's normal behavior
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
    ' Let you know the job's done
    MsgBox "Data copied successfully!", vbInformation
End Sub

Key improvements explained #

• Worksheet references: Using ThisWorkbook.Sheets("Sheet1") instead of ActiveSheet makes the code more reliable (it won't break if you switch tabs while running)
• Nested loops: The outer Do While handles iterating through Sheet1's rows, and the inner For loop takes care of pasting each row 5 times
• Row incrementing: Both rowSource and rowDest are updated properly, so we never get stuck on the same row
• Performance tweaks: Disabling screen updating and events makes the code run much faster, especially with large datasets

How to use this #

1. Open your Excel file
2. Press Alt + F11 to open the VBA Editor
3. Insert a new module (Right-click your workbook in the Project Explorer > Insert > Module)
4. Paste the code above
5. Press F5 to run it, or assign it to a button in Excel for easier access

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