| |
御世話になります。
特定のフォルダー内にあるファイルの決まった範囲を配列で取り込んで
別ファイルに1行で横へ追記していく動きをさせたく、色々なコードを
参考に作成しましたが、添字ｍの値が65で【実行時エラー９ インデックスが
有効範囲にありません】と表示され止ってしまいます。
あれこれ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
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
