特定の背景色のセル抜き出しマクロ

Sub 特定の背景色のセル抜き出しマクロ()

    
    Dim currentRange As Range
    Dim Rng As Range
    Dim firstAddress As String
    
    Dim copyBookName As String
    copyBookName = ActiveWorkbook.Name
    
    Application.FindFormat.Clear
    Application.FindFormat.Interior.Color = vbYellow
    
    '貼付先のブック作成
    Application.Workbooks.Add
    Dim xWs As Worksheet
    Set xWs = Application.ActiveSheet
    Dim pasteBookName As String
    pasteBookName = ActiveWorkbook.Name
    
    Workbooks(copyBookName).Activate
    Set currentRange = ActiveSheet.UsedRange.Find(What:="*", SearchFormat:=True)
    
    If currentRange Is Nothing Then
        MsgBox "修正箇所はありません"
        Exit Sub
    Else
        
        firstAddress = currentRange.Address
        

        Set Rng = currentRange
        Do
            Set currentRange = ActiveSheet.UsedRange.Find(What:="*", _
                                           After:=currentRange, _
                                           SearchFormat:=True)
            
            endrow = getEndRow(pasteBookName)
            endCol = getEndCol(pasteBookName)
            
            currentRange.Copy Destination:=xWs.Range(xWs.Cells(endrow, endCol))
            'currentRange.Copy Destination:=xWs.Range("A1")
            
            'ループ終了条件
            If currentRange Is Nothing Then Exit Do
            If currentRange.Address = firstAddress Then Exit Do
            
            '現在の該当セルを追加選択
            Set Rng = Union(Rng, currentRange)
        Loop
    End If
    
    
    Workbooks(pasteBookName).Activate
    
    'Dim xWs As Worksheet
    'Dim Rng As Range
    'Set Rng = Application.Selection
    
    'Application.Workbooks.Add
    'Set xWs = Application.ActiveSheet
    
    'Rng.Copy Destination:=xWs.Range("A1")

End Sub

Function getEndRow(bookName As String) As Integer
    
     Dim baseBookName As String
     baseBookName = ActiveWorkbook.Name
    
    Workbooks(bookName).Activate

    With ActiveSheet.UsedRange
        maxRow = .Rows(.Rows.Count).Row
        maxCol = .Columns(.Columns.Count).Column
    End With
    
    Workbooks(baseBookName).Activate

    getEndRow = maxRow
    
End Function

Function getEndCol(bookName As String) As Integer
    
     Dim baseBookName As String
     baseBookName = ActiveWorkbook.Name
    
    Workbooks(bookName).Activate

    With ActiveSheet.UsedRange
        maxRow = .Rows(.Rows.Count).Row
        maxCol = .Columns(.Columns.Count).Column
    End With
    
    Workbooks(baseBookName).Activate

    getEndCol = maxCol
    
End Function