0

シート 1 の 1 つのセル (D1) を、ワークブックの他のすべてのシートのセル (D1) にコピーしようとしています (ここでファイルをループしており、ワークシートの数はさまざまです)。

以下のコードを実行すると、「ActiveSheet.Paste」の行で次のエラーが表示されます:「実行時エラー '10004': ワークシート クラスの貼り付けメソッドに失敗しました」。

問題のあるコードは次のとおりです。

'copy MSA code to sheets!=1
Sub MSAallSheets(wb As Workbook)
    With wb
    Range("D1").Copy
        For Each ws In wb.Worksheets
            If ws.Name <> "Page 1" Then
            ws.Activate
            ws.Range("D1").Select
            ActiveSheet.Paste
            End If
        Next
    End With
End Sub

必要に応じて、ファイルのループを定義する方法を次に示します。

Dim Filename, Pathname As String
Dim wb As Workbook
Pathname = "C:\Users\julia.anderson\Documents\HMDA\test\"
Filename = Dir(Pathname & "*.xlsx")
Do While Filename <> ""
Set wb = Workbooks.Open(Pathname & Filename)
DoWork wb
Delete wb
MSAallSheets wb
wb.Close SaveChanges:=True
Filename = Dir()
Loop
End Sub

提案は大歓迎です！

ありがとうございました。

4

2 に答える 2

0

これは、わずかな変更で私にとってはうまくいきます：

Sub MSAallSheets(wb As Workbook, SourceSheet As String, SourceAddress As String)
    With wb
    Sheets(SourceSheet).Range(SourceAddress).Copy
        For Each ws In wb.Worksheets
            If ws.Name <> SourceSheet Then
                ws.Activate
                ws.Range(SourceAddress).Select
                ActiveSheet.Paste
            End If
        Next
    End With
End Sub

呼び出し例:

call MSAallSheets(activeWorkbook, "Page 1", "D1")

パラメータを使用すると、細部の変更やコードの再利用が容易になります。

于 2013-08-05T22:50:41.970 に答える
0

どのシートからコピーしているのかと思います...

Sub MSAallSheets(wb As Workbook)
    With wb
    Range("D1").Copy
        For Each ws In wb.Worksheets
            If ws.Name <> "Page 1" Then
                wb.Sheets("Page 1").Range("D1").Copy _
                                      ws.Range("D1")                      
            End If
        Next
    End With
End Sub
于 2013-08-05T22:41:15.723 に答える