Excel VBA宏问题求助：数据复制中断及输入区域清空需求

Hey Tom, let's work through your two VBA problems step by step—solving the truncated copy issue first, then adding the input-clearing functionality you need.

1. Fixing the "Only Copies 2 Rows" Problem #

The most common reasons your macro stops after two rows are either:

• A hardcoded row range (like only copying rows 2-3)
• An incorrect loop termination condition
• Not properly identifying the full range of data to copy

Here's a revised macro that will copy all your input data from Sheet1, paste it to Sheet2, and sort the data in descending order (I'll assume your data starts at A2 in Sheet1, with headers in row 1):

Sub SaveAndSortData()
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim lastSourceRow As Long
    Dim lastTargetRow As Long
    Dim sourceRange As Range
    
    ' Set references to your sheets (adjust names if needed)
    Set sourceSheet = ThisWorkbook.Sheets("Sheet1")
    Set targetSheet = ThisWorkbook.Sheets("Sheet2")
    
    ' Find the last row with data in Sheet1 (column A as the key column)
    lastSourceRow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row
    
    ' Make sure we're not just copying the header row
    If lastSourceRow < 2 Then
        MsgBox "No data to copy!", vbExclamation
        Exit Sub
    End If
    
    ' Define the range to copy (adjust columns if your data spans more columns)
    Set sourceRange = sourceSheet.Range("A2:D" & lastSourceRow)
    
    ' Find the next empty row in Sheet2 to paste the data
    lastTargetRow = targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Row + 1
    
    ' Copy and paste the data (values only, or keep formatting—adjust as needed)
    sourceRange.Copy
    targetSheet.Cells(lastTargetRow, "A").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    
    ' Sort the data in Sheet2 in descending order (using column A as the sort key)
    With targetSheet.Sort
        .SortFields.Clear
        .SortFields.Add Key:=targetSheet.Range("A2:A" & lastTargetRow + lastSourceRow - 2), _
            SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
        .SetRange targetSheet.Range("A1:D" & lastTargetRow + lastSourceRow - 2)
        .Header = xlYes ' Set to xlNo if Sheet2 doesn't have headers
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    ' Clear the copy clipboard
    Application.CutCopyMode = False
End Sub

Key Fixes in This Code: #

• It dynamically finds the last row of data in Sheet1, so it never misses rows
• It calculates the correct empty row in Sheet2 to avoid overwriting existing data
• The sort range is updated to include the newly pasted data, so all rows are sorted

2. Adding Input Clearing Functionality #

To clear the input area after saving, just add this block of code at the end of the macro (before End Sub). Adjust the range to match where your customers enter data (e.g., if they type in A2:D2, use that range):

' Clear the input area in Sheet1 (adjust the range to match your input fields)
    sourceSheet.Range("A2:D2").ClearContents
    ' Optional: Clear formatting too, if needed
    ' sourceSheet.Range("A2:D2").ClearFormats

Full Combined Macro #

Here's the complete macro with both features:

Sub SaveSortAndClear()
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim lastSourceRow As Long
    Dim lastTargetRow As Long
    Dim sourceRange As Range
    
    ' Set sheet references
    Set sourceSheet = ThisWorkbook.Sheets("Sheet1")
    Set targetSheet = ThisWorkbook.Sheets("Sheet2")
    
    ' Get last data row in Sheet1
    lastSourceRow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row
    
    If lastSourceRow < 2 Then
        MsgBox "No data to save!", vbExclamation
        Exit Sub
    End If
    
    ' Define data range to copy
    Set sourceRange = sourceSheet.Range("A2:D" & lastSourceRow)
    
    ' Find next empty row in Sheet2
    lastTargetRow = targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Row + 1
    
    ' Copy and paste data
    sourceRange.Copy
    targetSheet.Cells(lastTargetRow, "A").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    
    ' Sort Sheet2 data in descending order
    With targetSheet.Sort
        .SortFields.Clear
        .SortFields.Add Key:=targetSheet.Range("A2:A" & lastTargetRow + lastSourceRow - 2), _
            Order:=xlDescending
        .SetRange targetSheet.Range("A1:D" & lastTargetRow + lastSourceRow - 2)
        .Header = xlYes
        .Apply
    End With
    
    ' Clear input area
    sourceSheet.Range("A2:D2").ClearContents ' Adjust this range to your input fields
    
    ' Clean up clipboard
    Application.CutCopyMode = False
    
    MsgBox "Data saved and input area cleared!", vbInformation
End Sub

Quick Notes: #

• Adjust the column/range references (like A2:D or A2:D2) to match your actual spreadsheet layout
• If Sheet2 doesn't have headers, change .Header = xlYes to .Header = xlNo in the sort section
• The MsgBox at the end is optional, but it gives users confirmation that the action worked

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