diff --git a/XVBA/新版着工要因閲覧シート/vba-files/Module/Module1.bas b/XVBA/新版着工要因閲覧シート/vba-files/Module/Module1.bas
index db77d563..81d27514 100644
--- a/XVBA/新版着工要因閲覧シート/vba-files/Module/Module1.bas
+++ b/XVBA/新版着工要因閲覧シート/vba-files/Module/Module1.bas
@@ -342,6 +342,79 @@ Function FlattenRecord(record As Dictionary) As Dictionary
     Set FlattenRecord = flat
 End Function
 
+'******************************************************************************
+'Get�����Ŏ擾�������R�[�h���V�[�g�ɏ������ށiexportCSVDataToSheet�Ƃ͓Ɨ������j
+'�w�b�_�̓t���b�g�����1���ڃ��R�[�h�̃L�[�ꗗ�����̂܂܎g�p����i�����L�[���̂܂܁A���{�ꃉ�x���ϊ��͂��Ȃ��j
+Function getRecordsDataToSheet(records As Collection, targetSheet As String)
+    Debug.Print "���R�[�h���V�[�g�ɏo�͊J�n: " & targetSheet
+
+    If records.count = 0 Then
+        MsgBox "�f�[�^�����݂��܂���: " & targetSheet, vbExclamation
+        Exit Function
+    End If
+
+    Dim ws As Worksheet
+    On Error Resume Next
+    Set ws = ThisWorkbook.Sheets(targetSheet)
+    On Error GoTo 0
+
+    If ws Is Nothing Then
+        Debug.Print "�V�[�g�����݂��Ȃ����ߐV�K�쐬: " & targetSheet
+        Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.count))
+        ws.Name = targetSheet
+    End If
+
+    Dim flatRecords As New Collection
+    Dim rec As Variant
+    For Each rec In records
+        flatRecords.Add FlattenRecord(rec)
+    Next rec
+
+    Dim headerDict As Dictionary
+    Set headerDict = flatRecords(1)
+    Dim headerKeys As Variant
+    headerKeys = headerDict.Keys
+    Dim maxCols As Long
+    maxCols = headerDict.count
+
+    Dim i As Long, j As Long
+    Dim dataArr() As Variant
+    ReDim dataArr(1 To flatRecords.count, 1 To maxCols)
+    For i = 1 To flatRecords.count
+        Dim curRec As Dictionary
+        Set curRec = flatRecords(i)
+        For j = 1 To maxCols
+            dataArr(i, j) = curRec(headerKeys(j - 1))
+        Next j
+    Next i
+
+    Dim tbl As ListObject
+    On Error Resume Next
+    Set tbl = ws.ListObjects(targetSheet)
+    On Error GoTo 0
+
+    Dim headerRange As Range
+    Set headerRange = ws.Range("A1").Resize(1, maxCols)
+    For j = 0 To maxCols - 1
+        headerRange.Cells(1, j + 1).Value = headerKeys(j)
+    Next j
+
+    If tbl Is Nothing Then
+        Debug.Print "�e�[�u�������݂��Ȃ����ߐV�K�쐬: " & targetSheet
+        Set tbl = ws.ListObjects.Add(xlSrcRange, headerRange, , xlYes)
+        tbl.Name = targetSheet
+    End If
+
+    If Not tbl.DataBodyRange Is Nothing Then
+        tbl.DataBodyRange.ClearContents
+    End If
+
+    tbl.Resize tbl.Range.Resize(flatRecords.count + 1, maxCols)
+    tbl.DataBodyRange.Value = dataArr
+
+    Debug.Print "���R�[�h�̃V�[�g�o�͊���: " & targetSheet
+End Function
+
 '******************************************************************************
 'REST API�ďo����
 '�@method�@Get��POST��