Excelで表を使った顧客管理ソフトを作ってみよう

Private Function ExSheetNameMake() As String
    Dim tsheet As Object
    Dim ln As Long
    Dim lmax As Long
    Dim s1 As String
    
    lmax = 0
    For Each tsheet In ActiveWorkbook.Worksheets
        If Left(tsheet.Name, 4) = "抽出結果" Then
            s1 = Mid(tsheet.Name, 5, Len(tsheet.Name))
On Error Resume Next
            If s1 <> "" Then
                ln = Val(s1)
                If ln > lmax Then
                    lmax = ln
                End If
            End If
        End If
    Next
    ExSheetNameMake = ln + 1
End Function

Private Sub CommandButton4_Click()
    Dim sname As String
    Dim destsheet As Object
    Dim filarea As Object
    Dim ln As Long
    Dim i As Integer
    Dim s1 As String
    
   Set filarea = Worksheets("顧客一覧").Range("A4").CurrentRegion
    ln = filarea.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1
    If ln = 0 Then
        MsgBox "コピーするデータがありません。"
        Exit Sub
    End If
    
    ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
    s1 = ExSheetNameMake
    Worksheets(Worksheets.Count).Name = "抽出結果" & s1
    sname = Worksheets(Worksheets.Count).Name
    
    filarea.Resize(filarea.Rows.Count - 1).Offset(0).Copy Destination:=Worksheets(sname).Range("A4")
    Worksheets("顧客一覧").Select

    For i = 1 To 12
        Worksheets(sname).Cells(1, i).ColumnWidth = Worksheets("顧客一覧").Cells(1, i).ColumnWidth
    Next
End Sub