【EXCEL VBA（マクロ）】可視セルをコピーして右隣りのシートに貼り付け

可視セルだけをコピーして貼り付ける手順

このVBAは、フィルターで非表示にされた範囲のセルの値をコピーして、別の範囲に貼り付けるマクロです。

Sub CopyVisibleCells()
    'コピー元の範囲を選択する
    Dim rngSource As Range
    Set rngSource = Range("A1:C10")
    
    'フィルターで非表示にする
    rngSource.AutoFilter Field:=1, Criteria1:="<>"

    '非表示になったセルを選択し、コピーする
    rngSource.SpecialCells(xlCellTypeVisible).Copy
    
    'フィルターを解除する
    rngSource.AutoFilter
    
    'コピー先のセルを選択し、貼り付ける
    Range("D1").PasteSpecial xlPasteAll
    
    'コピー元の選択を解除する
    Application.CutCopyMode = False

MsgBox "完了" 
End Sub

解説

コピー元の範囲を選択する
コピー元の範囲をフィルターで非表示にする
非表示になったセルを選択し、コピーする
コピー元の範囲をフィルターで解除する
コピー先のセルを選択し、貼り付ける

この例では、A1:C10の範囲をコピー元としています。フィルターで非表示にするために、1列目の値が空ではない行を表示するようにフィルターを設定しています（Field:=1, Criteria1:="<>""）。SpecialCellsメソッドを使用して、非表示になったセルを選択しています。最後に、D1のセルに貼り付けています。

このようにすることで、非表示になっているセルはコピーされず、可視なセルだけがコピーされるため、必要な情報だけが貼り付けられます。

可視セルをコピーして右隣りのシートに貼り付ける

＊右隣りにシートが無いとエラーとなる

Sub 可視セルコピー貼付け()
    
'表全体のセル範囲を取得
Set A = ThisWorkbook.ActiveSheet.Range("A1").CurrentRegion
    
'可視セルのセル範囲を取得
Set A = A.SpecialCells(xlCellTypeVisible)
    
'可視セルをコピー
A.Copy
    
'可視セルを貼り付け
ThisWorkbook.ActiveSheet.Next.Range("A1").PasteSpecial
    
Application.CutCopyMode = False
Range("A1").Select

MsgBox "完了" 
End Sub

可視セルをコピーして新規シートを作成して貼り付ける

Sub 可視セルコピー貼付け_新規シート作成()
    
'表全体のセル範囲を取得
Set A = ThisWorkbook.ActiveSheet.Range("A1").CurrentRegion
    
'可視セルのセル範囲を取得
Set A = A.SpecialCells(xlCellTypeVisible)
    
'可視セルをコピー
A.Copy
    
'新規シート作成
Worksheets.Add(After:=ActiveSheet).Name = ActiveSheet.Name & "_" & VBA.Format(Now(), "h時mm分ss秒")
    
'可視セルを貼り付け
ThisWorkbook.ActiveSheet.Range("A1").PasteSpecial
 
Application.CutCopyMode = False
Range("A1").Select

MsgBox "完了"
End Sub

可視セルをコピーして右隣りのシートに貼り付け_シート名を変更

Sub 可視セルを右隣りのシートにコピー_シート名を変更()

Dim ws1 As Worksheet
Set ws1 = ThisWorkbook.ActiveSheet
Dim LastRow1 As Long
LastRow1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row
Dim LastCol1 As Long
LastCol1 = ws1.Cells(1, Columns.Count).End(xlToLeft).Column
Dim MyCell As Range
Set MyCell = ws1.Range("A1", Cells(LastRow1, LastCol1))   

Range("A1").CurrentRegion.Copy ActiveSheet.Next.Range("A1")  
'MyCell.Copy ActiveSheet.Next.Range("A1")

'シート名変更--------------------------
ActiveSheet.Next.Activate
Dim Num As Long
On Error Resume Next
ActiveSheet.Name = "→Copy"

Do
If Err.Number = 0 Then Exit Do
Err.Clear
Num = Num + 1
ActiveSheet.Name = "→Copy" & "_" & Num
Loop
'---------------------------------------

MsgBox "完了"
End Sub

参考

＜コピー・貼付け＞

Range("A1").CurrentRegion.Copy Destination:=Range("A7")

＜形式を選択して貼り付け＞

Range("A1").Copy
Range("C3").PasteSpecial Paste:=xlPasteValues

【マクロ・VBA】可視セルをコピーして右隣りのシートに貼り付ける