ＳＢＩ証券ポートフォリオからエクスポートした（ダウンロードした）データを見やすい形にしてみた。

Sub 新資産DB作成()


Dim Arrs() As Variant 'カテゴリー（株式、投資信託）
Dim Arr As Variant 'ArrsをFor each文で回すための変数
Dim dbheadArrs() As Variant 'データベースのヘッダー(上場銘柄バージョン）
Dim Arr2 As Variant 'dbheadArrsをFor each文で回すための変数
Dim i As Long 'データベースのシートにヘッダーを転記するためのインデックス番号
Dim fndRng, srcRng As Range '生データから目的のセルを探すための変数
Dim ffndRng As Range 'findNextメソッドを使用するための変数、findメソッドで最初に見つけたセル位置を格納
Dim delRng As Range '生データから不要な値を消去するセル範囲を取得するための変数
Dim sttRng As Range '生データから転記する範囲をとるための最初の範囲
Dim wsTem As Worksheet '一時保存用ワークシートの変数
Dim tableTem As ListObject '一時保存用ワークシートに転記したデータをテーブル化
Dim wsData As Worksheet 'データベースを作成するシート
Dim tableData As ListObject 'データベースをテーブル化

'================================================================
'①配列
'カテゴリー
Arrs() = Array("株式", "投資信託")
'dbのヘッダー
dbheadArrs() = Array("銘柄（コード）", "買付日", "数量", "取得単価", "現在値", "前日比", "前日比（％）", "損益", "損益（％）", "評価額")
'================================================================



'===============================================================
'②シート作成
'データベース用シート
Worksheets.Add before:=ThisWorkbook.Worksheets("貼り付け先")
Set wsData = ActiveSheet
wsData.Name = "資産DB"

'データベースのヘッダー
i = 1
For Each Arr2 In dbheadArrs()
    wsData.Cells(1, i).Value = Arr2
    i = i + 1
Next
Set tableData = wsData.ListObjects.Add(, wsData.Range("A1").CurrentRegion, , xlYes) 'データベースのテーブル化

'表を一時保存するシート (一時保存し､必要なデータだけデータベースに転記する)
Worksheets.Add before:=ThisWorkbook.Worksheets(1)
Set wsTem = ActiveSheet
'===============================================================



'===============================================================
'③データ整形と転記
'「合計」が値に含まれる行を全消去
'検索範囲
Set srcRng = ThisWorkbook.Worksheets("貼り付け先").Columns("A")

'検索範囲から「合計」が入っているセル範囲を検索、findNextで全検索
Set fndRng = srcRng.Find(what:="合計", lookat:=xlPart)
Set ffndRng = fndRng '最初に検索したセル位置を記憶
Set delRng = fndRng '不要なデータとして消去する範囲を取る、先ずは最初に検索した範囲を取得。

'Do loopで全検索、検索するたびにdelRngに消去する範囲を格納していく。
Do
    Set delRng = Union(delRng.EntireRow, fndRng.EntireRow)
    Set fndRng = srcRng.FindNext(fndRng)
Loop Until fndRng.Address = ffndRng.Address

'delRngをクリアー
delRng.ClearContents

'「株式」、「投資信託」が値に含まれる行を検索、その行に行を挿入し、1行空白を作る。
For Each Arr In Arrs()
    '「株式」、「投資信託」を順に検索
    Set fndRng = srcRng.Find(what:=Arr, lookat:=xlPart)
    '最初に検索したセル位置を記憶
    Set ffndRng = fndRng
    
    Do
        '検索したセルの一つ右のセルが空白かどうか判断
        '空白なら処理
        '空白でないならlabelまで飛ばす
        'これをしないとファンド名の「株式」とかを検索してしまうので。
        If fndRng.Offset(, 1).Value <> "" Then
            GoTo label
        End If
        
        '行を挿入することで、目的の表をcurrentregionで取得できるようにする
        fndRng.EntireRow.Insert
        '行の挿入後、表を一時保存に転記
        fndRng.Offset(1).CurrentRegion.Offset(1).Copy wsTem.Range("A1")
        
        '一時保存ワークシートに一時的に保存したデータをテーブル化
        Set tableTem = wsTem.ListObjects.Add(, wsTem.Range("A1").CurrentRegion, , xlYes)
        
            '「株式」のデータか「投資信託」のデータかで見出しが変わるので対応
            If Arr = "株式" Then
                dbheadArrs() = Array("銘柄（コード）", "買付日", "数量", "取得単価", "現在値", "前日比", "前日比（％）", "損益", "損益（％）", "評価額")
            Else
                dbheadArrs() = Array("ファンド名", "買付日", "数量", "取得単価", "現在値", "前日比", "前日比（％）", "損益", "損益（％）", "評価額")
            End If
            '見出しを合うように変える
            tableData.HeaderRowRange(1).Value = dbheadArrs(0)
        
        'テーブルの結合
        'データベースに追加行を入れ、それぞれ該当の見出しにコピペ
        '一時保存テーブル→データベースに転記している。
        'データベースにある列が一時保存テーブルにない場合はon error resume nextで次へ飛ばす。
        With tableData.ListRows.Add
            For Each Arr2 In dbheadArrs()
                On Error Resume Next
                tableTem.ListColumns(Arr2).DataBodyRange.Copy
                .Range(tableData.ListColumns(Arr2).Index).PasteSpecial xlPasteValues
                On Error GoTo 0
            Next
        End With
        
        '買付日を日付のフォームに変える
        tableData.ListColumns("買付日").DataBodyRange.NumberFormatLocal = "yyyy/mm/dd"
        '一時保存シートを消去し、次に備える
        wsTem.Columns("A:CZ").Delete
        
label:
        Set fndRng = srcRng.FindNext(fndRng)
    Loop Until fndRng.Address = ffndRng.Address '最初に検索したセルまで検索したら終了
Next
'=========================================================================================


'不要なシートデータを削除
Application.DisplayAlerts = False
'一時保存シートを削除
wsTem.Delete
'貼り付けたデータを削除
ThisWorkbook.Worksheets("貼り付け先").Columns("A:CZ").Delete
Application.DisplayAlerts = True

'購入していないけどＣＳＶに載ってくる銘柄→お気に入りで監視している銘柄だと思うので、
'ポートフォリオには不要だから消去
Call お気に入り分削除


End Sub

Sub お気に入り分削除()

Dim tableData As ListObject
Dim wsData As Worksheet

Set wsData = ThisWorkbook.Worksheets("資産DB")
Set tableData = wsData.ListObjects(1)

With tableData
    .Range.AutoFilter field:=.ListColumns("数量").Index, Criteria1:="--"
    .DataBodyRange.SpecialCells(xlCellTypeVisible).EntireRow.Delete
    .Range.AutoFilter
End With
End Sub