VBA中For嵌套Do While循环报错：周工时记录脚本故障排查

Hey Benno_S, let's break down this VBA error you're hitting with your weekly time-tracking script. First, let's recap your goal: you want to copy the daily hours from This Week!B27:G27 (Monday to Saturday) to the Hours sheet, preserving the data so it doesn't get lost when you update the This Week sheet.

Common Causes of That "Application-defined or object-defined error" #

Your nested For/Do While loop is likely tripping up for one of these reasons:

• Mismatched row tracking: If you're using Do While to find the next empty row per column, you'll end up with inconsistent row numbers across columns (e.g., B column uses row 10, but G column uses row 8) — this can cause you to reference cells outside valid ranges.
• Unqualified worksheet references: If you don't explicitly specify which workbook/sheet your cells belong to, VBA might default to the wrong sheet, leading to an object-not-found error.
• Infinite loop risk: If your Do While condition never resolves to False, you'll eventually hit Excel's row limit and trigger an error.

Fixed Solutions #

You don't even need nested loops for this task — here are two clean, reliable approaches:

1. Copy Entire Range (Fastest Method)

This copies the whole block of hours at once, no loops needed:

Sub SaveWeeklyHours()
    ' Define worksheet objects to avoid confusion
    Dim wsThisWeek As Worksheet
    Dim wsHours As Worksheet
    Dim nextEmptyRow As Long
    
    ' Assign the sheets (make sure names match exactly!)
    Set wsThisWeek = ThisWorkbook.Worksheets("This Week")
    Set wsHours = ThisWorkbook.Worksheets("Hours")
    
    ' Find the next empty row in the Hours sheet (using column B as reference)
    nextEmptyRow = wsHours.Cells(wsHours.Rows.Count, "B").End(xlUp).Row + 1
    
    ' Copy the hours from This Week to the next empty row in Hours
    wsThisWeek.Range("B27:G27").Copy Destination:=wsHours.Range("B" & nextEmptyRow & ":G" & nextEmptyRow)
    
    ' Optional: If you only need values (not formatting), use this instead (faster):
    ' wsHours.Range("B" & nextEmptyRow & ":G" & nextEmptyRow).Value = wsThisWeek.Range("B27:G27").Value
End Sub

2. Simple For Loop (If You Prefer Iterating Columns)

If you want to stick with a loop (maybe for future expansion), fix the row tracking first:

Sub SaveHoursWithLoop()
    Dim wsThisWeek As Worksheet
    Dim wsHours As Worksheet
    Dim colIndex As Integer
    Dim nextEmptyRow As Long
    
    Set wsThisWeek = ThisWorkbook.Worksheets("This Week")
    Set wsHours = ThisWorkbook.Worksheets("Hours")
    
    ' Find the next empty row ONCE, before looping columns
    nextEmptyRow = wsHours.Cells(wsHours.Rows.Count, "B").End(xlUp).Row + 1
    
    ' Loop through columns B to G (column indices 2 to 7)
    For colIndex = 2 To 7
        wsHours.Cells(nextEmptyRow, colIndex).Value = wsThisWeek.Cells(27, colIndex).Value
    Next colIndex
End Sub

Key Fixes from Your Original Code #

• We define worksheet objects explicitly (wsThisWeek/wsHours) so VBA never guesses which sheet to use.
• We find the next empty row once before looping, instead of per column — this keeps all your hours aligned in the same row.
• We avoid unnecessary Select/Activate calls, which are a common source of VBA errors.

Give either of these a try, and double-check that your sheet names match exactly (no extra spaces!).

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