| 
    
     |  | 御世話になります。 特定のフォルダー内にあるファイルの決まった範囲を配列で取り込んで
 別ファイルに1行で横へ追記していく動きをさせたく、色々なコードを
 参考に作成しましたが、添字mの値が65で【実行時エラー9 インデックスが
 有効範囲にありません】と表示され止ってしまいます。
 あれこれ1日半ぐらい考えましたが解決する力量が無く
 ご助言など頂けますようお願い致します。
 
 
 Sub 新規レコード転記2()
 Dim SaleAry As Variant
 Dim i As Integer
 Dim j As Integer
 Dim m As Integer
 Dim a As Integer
 Dim b As Integer
 
 Dim SULastRow As Long
 Dim DSLastRow As Long
 Dim FolderName As String
 Dim FileNeme As String
 
 ダイアログ表示:
 
 FolderName = フォルダーダイアログ()
 
 FileNeme = Dir(FolderName & "\*.xls", vbNormal)
 
 If FileNeme = "" Then
 MsgBox "EXCEL ブックがありません"
 
 GoTo ダイアログ表示
 
 End If
 
 Do While FileNeme <> ""
 
 Workbooks.Open (FolderName & "\" & FileNeme)
 With Worksheets(1)
 
 SaleAry = Range("A7:I14").Value
 
 End With
 
 l = 0
 m = 0
 
 a = UBound(SaleAry)
 b = UBound(SaleAry, 2)
 
 
 With ThisWorkbook.Worksheets("殺菌条件")
 
 DSLastRow = ThisWorkbook.Worksheets("殺菌条件").Range("B65536").End(xlUp).Row
 
 For j = 1 To b
 For i = 1 To a
 
 m = m + 1
 
 .Cells(DSLastRow + 1, m).Value = SaleAry(j, i)
 
 Next i
 i = 1
 Next j
 
 Set SaleAry = Nothing
 
 
 End With
 
 ActiveWorkbook.Close
 
 FileNeme = Dir()
 
 Loop
 
 ThisWorkbook.Worksheets("殺菌条件").Activate
 
 End Sub
 
 |  |