Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


4651 / 13646 ツリー ←次へ | 前へ→

【55418】特定のセル検索と数式のコピー貼り付け kuri 08/5/2(金) 23:58 質問[未読]
【55419】Re:特定のセル検索と数式のコピー貼り付け kuri 08/5/3(土) 11:29 回答[未読]

【55418】特定のセル検索と数式のコピー貼り付け
質問  kuri  - 08/5/2(金) 23:58 -

引用なし
パスワード
   お世話になります。

マクロ初心者なりに、試行錯誤しここまでたどり着く事が出来ましたが、うまく意図通りのマクロが組めません。良きアドバイスを頂ければと思います。

[やりたい事]
1.B列内にセル背景色:茶色のセルがあるか検索する(該当するセルが2つ存在します)
2.検索した結果のアドレス(変数)を格納する [例 B2,B10]
3.検索した上部のセル[例 B2]に数式が入力されているので、コピーする
4.検索した上、下セル範囲内[例 B2:B10]に数式を貼り付ける

→おそらく1〜3までは出来ていると思います。
 4の数式の貼り付けをする際、セルにデータが入力されていると貼り付けされずに困っています。

[コード]
Sub 茶色セル選択()

  Dim FoundCell As Range
  Dim Addr As String
  Dim SearchArea As Range
  Dim FoundAddr() As String
  Dim i As Long

  
    With Application.FindFormat.Interior.ColorIndex = 53
    End With
    Set SearchArea = Worksheets("Sheet1").UsedRange.Columns(1)
    Set FoundCell = SearchArea.Find(What:="", SearchFormat:=True)
    If FoundCell Is Nothing Then Exit Sub
    Addr = FoundCell.Address 
        Do
        ReDim Preserve FoundAddr(i)
        FoundAddr(i) = FoundCell.Address
        Set FoundCell = SearchArea.FindNext(after:=FoundCell)
        i = i + 1
  Loop While FoundCell.Address <> Addr And Not FoundCell Is Nothing
  
    Range("B2").Select
  Selection.Copy
  Range(Join(FoundAddr, ",")).Select
  Selection.PasteSpecial Paste:=xlPasteFormulas
  
End Sub

よろしくお願いします。

【55419】Re:特定のセル検索と数式のコピー貼り付け
回答  kuri  - 08/5/3(土) 11:29 -

引用なし
パスワード
   投稿した後、いろいろ試行錯誤して、問題が解決しましたので、ご報告致します。

投稿したコードを実行する前に、B2以降のデータを削除するようコードを実行させたら、解決しました。

以上です。

4651 / 13646 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free