セル書式を書き出す

この表の各セルの書式を赤い罫線内に書き出す

A列：文字列（A4のみ標準）、B列：数値、C列：通貨

1行目はタイトルなので値をコピー

    Dim lngMaxRow As Long
    Dim lngMaxCol As Long
    
    Dim i As Integer
    Dim j As Integer

    '表内最大行を取得
    lngMaxRow = lngGetMaxRow(ActiveSheet)
    
    '表内最大列を取得
    lngMaxCol = lngGetMaxCol(ActiveSheet)
    
    
    For i = 1 To lngMaxRow  '最大行まで繰り返す
    
        For j = 1 To lngMaxCol  '最大列まで繰り返す
        
            If i = 1 Then
                '1行目はタイトルなので値をコピー
                ActiveSheet.Cells(i, j + 5).Value = ActiveSheet.Cells(i, j).Value
            Else
                '2行目以降は1セルずつ書式を記述する（5列先）
                Call WriteRangeFormat(ActiveSheet.Cells(i, j), ActiveSheet.Cells(i, j + 5))
            End If
            
        Next j
        
    Next i

【呼び出し関数】

'------------------------------------------------------
'セルの書式設定を書き出す
'
'   戻値：なし
'
'   引数：コピー元セル（範囲指定は不可）
'       ：コピー先セル（範囲指定可）
'
'   注意：コピー元セルが複数指定されている場合エラーとする
'-------------------------------------------------------
Sub WriteRangeFormat(rngMoto As Range, rngSaki As Range)
    
    If rngMoto.Count > 1 Then
    
        'エラー処理を行う（ログを出す、セルを色づけする等）
        
        Exit Sub
        
    End If
    
    rngSaki.Value = rngMoto.NumberFormatLocal
    
End Sub

【結果】