Sub 集計データを表に持ってくる2()
Dim ws5 As Worksheet
Set ws5 = Worksheets("集計")
Dim ws1 As Worksheet
Set ws1 = Worksheets("貼付")
Dim lr As Long
Dim colm As Long
Dim lr2 As Long
Dim colm2 As Long
Dim i As Long
Dim dtRange As Range
Dim array1 As Variant
colm = 3
colm2 = 4
' 貼付シートのD列の次の空白行を取得
lr2 = ws1.Cells(rows.Count, colm2).End(xlUp).Row + 1
' 貼付シートのD列を範として取得
Set dtRange = ws1.Range(Cells(8, colm2), Cells(lr2 - 1, colm2))
lr = ws5.Cells(rows.Count, colm).End(xlUp).Row
array1 = ws5.Range(ws5.Cells(3, colm), ws5.Cells(lr, colm))
' データをコピーして貼り付け
For i = 1 To UBound(array1)
If array1(i, 1) >= 1 Then
' 数値が1以上かつD列に存在しない場合、左隣のセルの値をD列に追加
If WorksheetFunction.CountIf(dtRange, ws5.Cells(i + 2, 2).Value) = 0 Then
ws1.Cells(lr2, colm2).Value = ws5.Cells(i + 2, 2).Value
lr2 = lr2 + 1
End If
End If
Next i
MsgBox "データが追加されました。", vbInformation
End Sub
Sub データ集計前の非表示処理()
Range("1:7").EntireRow.Hidden = True
Range("1:7").EntireRow.Hidden = False
End Sub