VBAマクロ　大量Excelファイルのデータ転記

前提・実現したいこと

Excelファイルから、Excelファイルへデータを転記するExcelマクロを作成したいです。
下記ご確認いただき、知恵をお貸しいただきたいです。

【内容】
顧客からの問い合わせを、問い合わせ1件につき1つのExcelファイルで管理しています。
問い合わせファイル内には、問い合わせの内容・対応した内容・対応日などを記載しており、問い合わせファイルは対応のステータス毎（未対応、対応中、対応完了）にフォルダを分けて管理しています。
3つのフォルダに別れた全ての問い合わせファイルを、以下条件の元、一覧として作成するマクロを作成したいです。（集計などを行うために一覧にしたいです）

【前提条件】

一覧ファイル（マクロブック）は、未対応フォルダ、対応中フォルダ、対応完了フォルダと同フォルダ内にある。

─┬─ 一覧ファイル
''''├─ 未対応フォルダ
''''├─ 対応中フォルダ
''''└─ 対応完了フォルダ

一覧ファイルへは、問い合わせファイルを1レコードとし、ファイル内すべての内容（問い合わせ内容・対応内容・対応日など）を転記する。

※一覧ファイルのB列～BM列に64このデータを転記する。A列は、レコードの1件目から順に自動で番号を採番する。）
※また一覧ファイルの11行目までは、タイトル行としているため、12行目から転記を始める。

一覧ファイルの特定のカラム（AQ列：対応完了日）が空白でない場合（対応が完了している）は、該当する問い合わせファイルから転記は行わず、

AQ列が空白の場合（対応が完了していない）のみ、該当する問い合わせファイルから転記を行う。（処理時間短縮のため）

問い合わせファイルは、日に日に新規で追加される。
処理効率化のため、データを転記する際は、配列を利用したい。

【補足】
問い合わせファイルのファイル名は一意であり、ファイル名は、「◯_aaa.xlsx」となっています。
aaa（以下、管理番号と呼ぶ）の部分は、問い合わせファイル内のセルを参照しており、一覧に転記した場合、管理番号は一覧ファイルのD列に転記される。

【作成したソースコード概要】

① 一覧のAQ列が空白ではない（対応が完了してる）レコードの管理番号を取得する
② 一覧からAQ列が空白（対応が完了していない）レコードをクリアする
③ 問い合わせがファイルのパスを取得する
④ ①で取得した管理番号をキーに、問い合わせファイルのファイル名の一部（管理番号の部分）と一致しない場合、⑤の処理を実行
⑤ 問い合わせファイルを開いて、データを一覧に転記する
⑥ 作成した一覧を、ソート、リファレンスナンバーを採番

上記イメージでソースコードを作成しようと思っていますが、ソースコード作成のアドバイスや、配列に格納して転記する方法もご教示いただければと思います。
エンジニアではないため拙い部分のあり、また最近VBA独学で勉強しているため基本を理解していないところもあるかもしれませんが、ご了承ください。
宜しくお願い致します。

発生している問題・エラーメッセージ

作成した下記ソースコードでは、★の箇所で「インデックスが有効範囲にありません」とエラーになります。
他に下記ソースコードに問題がある場合も、ご指摘いただければ幸いです。

該当のソースコード

VBA
1Option Explicit
2
3    Dim intRet      As Integer
4    Dim wb          As Workbook
5    Dim ws          As Worksheet
6    Dim rng        As Range
7    Dim finNum()   As Variant    '対応完了の管理番号
8    Dim nyNum()    As Variant    '対応未完了の管理番号
9    Dim i           As Integer    '対応完了の配列変数
10    Dim j           As Integer    '対応未完了の配列変数
11    Dim num         As Variant
12    Dim file        As Object
13    Dim cnt         As Integer
14
15    Public Sub 一覧作成()
16
17        '処理時間計測用変数
18        Dim starttime As Double
19        Dim endtime As Double
20        Dim processtime As Double
21
22        '一覧作成の実行確認
23        intRet = MsgBox("表を最新の状態にします。よろしいですか？", vbOKCancel, "確認")
24        If intRet <> vbOK Then
25            Exit Sub
26        End If
27
28        '開始時間取得
29        starttime = Timer
30
31        '画面更新を停止
32        With Application
33            .ScreenUpdating = False
34            .EnableEvents = False
35            .Calculation = xlCalculationManual
36        End With
37
38        'シートの非表示行を表示する
39        Cells.EntireColumn.Hidden = False
40
41        Set wb = ActiveWorkbook
42        Set ws = ActiveSheet
43
44        '一覧にある管理NOを取得する
45        For Each rng In ws.Range("AQ12", ws.Cells(ws.Rows.Count, "AQ").End(xlUp))
46            If ws.Cells(rng.row, 43) <> "" Then
47                For i = LBound(finNum) To UBound(finNum) '/★ここで上記エラーになります
48                    finNum(i) = ws.Cells(rng.row, 4)
49                Next
50'            ElseIf ws.Cells(rng.row, 43) = "" Then
51'                For j = LBound(nyNum) To UBound(nyNum)
52'                    nyNum(j) = ws.Cells(rng.row, 4)
53'                Next
54            End If
55        Next
56
57        '対応完了日（AQ列）が空白の行の値をクリアする
58        Dim rw As Integer
59        For Each rng In ws.Range("AQ12", ws.Cells(ws.Rows.Count, "AQ").End(xlUp))
60            If ws.Cells(rng.row, 43) = "" Then
61                rw = ws.Cells(rng.row, 43).row
62                Rows(rw).ClearContents
63            End If
64        Next
65
66        '問い合わせファイルのパスを取得
67        Dim Fld()        As String
68        Dim a            As Integer
69        Dim fso          As Object 'FileSystemObject
70        Dim BaseNames()  As String
71        Dim Names()      As String
72        Dim intPos       As Integer
73
74        Const strDefFild As String = "問合票"
75
76        Fld(0) = wb.Path & "\10 未対応"
77        Fld(1) = wb.Path & "\20 対応中"
78        Fld(2) = wb.Path & "\30 対応済み"
79
80        Set fso = CreateObject("Scripting.FileSystemObject")
81        For a = 0 To 2
82            For Each file In fso.GetFolder(Fld(a)).Files
83                cnt = cnt + 1
84                BaseNames(cnt) = fso.GetBaseName(file.Name)
85                intPos = InStr(BaseNames(cnt), strDefFild)
86                Names(cnt) = Mid(BaseNames(cnt), intPos + 2)
87                '対応完了以外の問合票ファイルを一覧へ取り込み（対応未完了 + 新規）
88                If Names(cnt) <> finNum(i) Then
89                    Call 取り込み
90                End If
91            Next
92        Next
93
94        Call 項番採番
95
96        '終了時間取得
97        endtime = Timer
98
99        '処理時間取得
100        processtime = endtime - starttime
101
102        Range("A3").Select
103
104        MsgBox "一覧作成しました。" & "（処理時間：" & processtime & "秒）"
105
106        '画面更新を再開
107        With Application
108            .Calculation = xlCalculationAutomatic
109            .EnableEvents = True
110            .ScreenUpdating = True
111        End With
112
113    End Sub
114
115    '★問合票ファイルを一覧へ取り込み
116    Public Sub 取り込み()
117        Dim row As Integer
118        Dim clm As Variant
119        Dim s   As Worksheet
120
121        For row = 12 To cnt
122            For Each clm In ws.Range("A11", s.Cells(11, s.Columns.Count).End(xlToLeft))
123                With Workbooks.Open(file.Path, UpdateLinks:=False, ReadOnly:=True)
124                    Set s = .Sheets("問い合わせ一覧票")
125                    file.Cells(row, clm).Value = s.Cells(10, 33).Value
126
127		　　（文字数の関係により省略）
128
129                    file.Cells(row, clm).Value = s.Cells(2, 45).Value
130                    file.Cells(row, clm).Value = s.Cells(2, 46).Value
131                End With
132            Next clm
133        Next
134    End Sub
135
136    '作成した一覧をソート、項番採番
137    Sub 項番採番()
138
139        Dim L As Integer
140        Dim n As Integer
141
142        Set wb = ActiveWorkbook
143        Set ws = ActiveSheet
144
145        'ソート
146        Range("A12", ws.Cells(ws.Rows.Count, "D").End(xlUp).Offset(0, -3)).Select
147        Selection.Sort Key1:=Range("D12"), Order1:=xlAscending, _
148                       Key2:=Range("E12"), Order2:=xlAscending, Header:=xlYes, _
149                       OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin
150
151        '番号付け
152        L = 12
153        n = 1
154
155        While wb.ws.Cells(L, 4).Value <> ""
156            wb.ws.Cells(L, 1).Value = n
157            L = L + 1
158            n = n + 1
159        Wend
160    End Sub
161

補足情報（FW/ツールのバージョンなど）

Excel2016

行動規範の内容に同意します

回答1件

                For i = LBound(finNum) To UBound(finNum) '/★ここで上記エラーになります
                    finNum(i) = ws.Cells(rng.row, 4)
                Next

finNum　配列、LBound(finNum) To UBound(finNum)の前のどこで作られているのでしょう？

        For Each rng In ws.Range("AQ12", ws.Cells(ws.Rows.Count, "AQ").End(xlUp))
            If ws.Cells(rng.row, 43) <> "" Then
                    finNum(i) = ws.Cells(rng.row, 4)
　　　　　　　　　i=i+1
            End If
        Next

finNum()がここで作成される。これで良さそうですが、

投稿2020/05/04 05:59