値の一致でコピーし、値と数式の書式で貼り付け

投稿者 : ふとしくん     投稿日時 : 2024/08/05(Mon) 17:27:41     OS : 未指定     EXCEL : 未指定

---

シートAのG列の田中をコピーし、シートBのG列の最終行の2行下に「値と数式の書式」で貼り付けしたく、下記コードをネット見ながら作成しました。
結果は一部のみが貼り付けでうまく作動しませんでした。
G列は2行でセル結合されています。このコードを書いたマクロ用ブックを起動させ、対象のブックを開き、マクロ実行しています。
すいませんが、お気づきの点ありましたら教えてください。
詳細の説明不足ありましたらお許しください。
よろしくお願いします。

Sub macro()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim lastRowA As Long
    Dim lastRowB As Long
    Dim i As Long
    Dim copyRange As Range
    Dim cellValue As String
    
    ' シートを設定
    Set ws1 = ActiveWorkbook.Sheets("シートA")
    Set ws2 = ActiveWorkbook.Sheets("シートB")
    
    ' ws1のG列の最終行を取得
    lastRowA = ws1.Cells(ws1.Rows.Count, "G").End(xlUp).Row
    
    ' ws2のG列の最終行を取得
    lastRowB = ws2.Cells(ws2.Rows.Count, "G").End(xlUp).Row
    
    ' シートAのG列で「田中」と一致する行を探してコピー
    For i = 10 To lastRowA Step 2
        cellValue = ws1.Cells(i, "G").Value
        
        If cellValue = "田中" Then
            ' 「田中」が見つかった場合、その行をコピーする範囲を設定
            If copyRange Is Nothing Then
                Set copyRange = ws1.Rows(i)
            Else
                Set copyRange = Union(copyRange, ws1.Rows(i))
            End If
        End If
    Next i
    
    ' コピーする行が見つかった場合
    If Not copyRange Is Nothing Then
        ' シートBのG列の最終行の2行下にコピー
        ws2.Rows(lastRowB + 2).Resize(copyRange.Rows.Count, copyRange.Columns.Count).Value = copyRange.Value
        ws2.Rows(lastRowB + 2).Resize(copyRange.Rows.Count, copyRange.Columns.Count).NumberFormat = copyRange.NumberFormat
    End If
     
End Sub

投稿者 : とおりすがり     投稿日時 : 2024/08/05(Mon) 19:10:08

---

copyRange.Rows.CountはcopyRange.Areas(1).Rows.Count

copyRange.ValueはcopyRange.Areas(1).Value

投稿者 : てらてら     投稿日時 : 2024/08/05(Mon) 19:58:27

---

こんにちは。

>お気づきの点ありましたら教えてください。

私なら copyRange は使いません。
それと、田中さんが二人いたら不具合が起こるでしょう。

Sub macro2()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim lastRowA As Long
    Dim lastRowB As Long
    Dim i As Long
    Dim cellValue As String
    
    ' シートを設定
    Set ws1 = Worksheets("シートA")
    Set ws2 = Worksheets("シートB")
    
    ' ws1のG列の最終行を取得
    lastRowA = ws1.Cells(ws1.Rows.Count, "G").End(xlUp).Row
    
    ' ws2のG列の最終行を取得
    lastRowB = ws2.Cells(ws2.Rows.Count, "G").End(xlUp).Row
    
    ' シートAのG列で「田中」と一致する行を探してコピー
    For i = 10 To lastRowA Step 2
        cellValue = ws1.Cells(i, "G").Value
        
        If cellValue = "田中" Then
            ' 「田中」が見つかった場合、シートBのG列の最終行の2行下にコピー
            ws1.Rows(i).Resize(2).Copy ws2.Rows(lastRowB + 2)
            
            ' 田中さんが一人とは限らない
            lastRowB = ws2.Cells(ws2.Rows.Count, "G").End(xlUp).Row
        End If
    Next i
     
End Sub

投稿者 : ふとしくん     投稿日時 : 2024/08/05(Mon) 21:51:39

---

てらてら様ありがとうございます。
教えていただいたコードでうまく動作しました。
追加質問で恐縮ですが、貼り付けする際「値と数式の書式」で行うことは可能でしょうか？
ネットで、値と数値の書式→xlPasteValuesAndNumberFormatsと見つけたのですが、使いこなせませんでした。
この形式で貼り付けしたい理由は、コピー元に別シートのセルを見に行く数式が入っており、現在の貼り付けですと値が変わってしまいました・・・。
「値と数式の書式」での貼り付けがそのまま値を貼り付けでき、この貼り付けでいきたいと思っていまして・・・。

入っている数式の例↓
=function(表!AG775,表!AH775)
現在の貼り付けすると↓
=function(管理表!AG745,管理表!AH745)
となる。

すいません、お願いする立場ではございませんが、よろしくお願いできれば幸いです。
そもそも考えが違っていれば、ご指導ください。

投稿者 : てらてら     投稿日時 : 2024/08/06(Tue) 07:09:05

---

コピー元シートの数式をConvertFormulaメソッドで絶対参照にするとか。

投稿者 : ふとしくん     投稿日時 : 2024/08/06(Tue) 13:52:37

---

てらてら様、ありがとうございます。
コピー元シートをさわるのは難しい事情がありまして。
やはり「値と数式の書式」での貼り付けは難しいことなのですね。
色々とありがとうございました。