VBA多工作表复制范围报错：Data Member Not Found问题求助

Hey there! Let's tackle that "Data Member Not Found" error you're hitting. The root cause is a simple mix-up between referencing a collection of worksheets and an individual worksheet object in your loop.

What's Causing the Error? #

You defined sheetsArray as a Sheets collection (a group of your 4 target sheets), but then tried to call .Cells directly on this collection with sheetsArray.Cells(...). The Cells property only exists on single Worksheet objects—not on a collection of sheets. Your For Each sheetObject In sheetsArray loop is already grabbing each individual worksheet, you just need to use that variable instead of the collection.

Corrected Code #

Here's the fixed version of your script, with extra improvements for reliability and efficiency:

Sub copyColumns()
    Dim months As Variant, m1 As Variant, m2 As Variant
    Dim sourceSht As Worksheet
    Dim Msg As String, Ans As Variant
    Dim sheetsArray As Sheets
    Dim sheetObject As Worksheet
    
    ' Confirm action with user
    Msg = "Are you sure you want to copy/paste over to Early Warning?"
    Ans = MsgBox(Msg, vbYesNo)
    
    Select Case Ans
        Case vbYes
            ' Define month array for matching
            months = Split("Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec", ",")
            Set sheetsArray = ActiveWorkbook.Sheets(Array("HRM", "SRM", "NRM", "Corp"))
            Set sourceSht = ThisWorkbook.Worksheets("Macros")
            
            ' Get month positions, handle possible match errors
            m1 = Application.Match(sourceSht.Range("Month1").Value, months, 0)
            m2 = Application.Match(sourceSht.Range("Month2").Value, months, 0)
            
            ' Validate matches to avoid runtime errors
            If IsError(m1) Or IsError(m2) Then
                MsgBox "Invalid month selection! Please check Month1 and Month2 dropdowns.", vbExclamation
                GoTo Quit
            End If
            
            ' Turn off screen updates for speed
            Application.ScreenUpdating = False
            
            ' Loop through each sheet in the collection
            For Each sheetObject In sheetsArray
                ' Direct value assignment (faster than copy/paste)
                With sheetObject
                    .Range(.Cells(35, 17 + m1), .Cells(376, 17 + m2)).Value = _
                        .Range(.Cells(35, 4 + m1), .Cells(376, 4 + m2)).Value
                End With
            Next sheetObject
            
            ' Re-enable screen updates
            Application.ScreenUpdating = True
            MsgBox "Data copied successfully!", vbInformation
            
        Case vbNo
            GoTo Quit
    End Select
    
Quit:
    ' Ensure screen updates are re-enabled even if an error occurs
    Application.ScreenUpdating = True
End Sub

Key Fixes & Improvements #

• Fixed the core error: Replaced all sheetsArray.Cells/sheetsArray.Range references with sheetObject.Cells/sheetObject.Range (using With sheetObject for cleaner syntax).
• Removed copy/paste overhead: Directly assigning values is faster and avoids issues with the clipboard.
• Added validation: Checks if Match returns an error (e.g., if the dropdown has an invalid month) and shows a user-friendly message.
• Optimized performance: Disabled ScreenUpdating during the loop to prevent flickering and speed up execution.
• Safety net: Ensures ScreenUpdating is re-enabled even if the script exits early due to an error.

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