|
めぐ さん、こんばんわ。
遅くなってすみません。
>301在庫.txtの301在庫シートに8行挿入し、その行を文字列に置き換えます。
>次にザイコ一覧.xlsにあるデータをコピーしまして、それを301在庫.txtの301在庫シートのD2からはりつけます。
Active(Window,Sheet)やSelectにまかせてシートやブックを移動しながら処理すると、自分の意思と違うところに処理する可能性があるので、出来る限り処理対象のオブジェクトは明確にすることがエラー回避と処理速度向上の第一歩だと思います。
Sub Macro2()
'
' Macro2 Macro
' マクロ記録日 : 2003/10/23 ユーザー名 :
'
Dim ws(1 To 3) As Worksheet, II As Integer
Dim wb1 As Workbook, wb2 As Workbook
'
Workbooks.OpenText Filename:="D:\DATA\301在庫.txt", _
StartRow:=1, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _
Tab:=True, Semicolon:=False, Comma:=True, Space:=False, _
Other:=False, FieldInfo:=Array(Array(1, 2), Array(2, 2), _
Array(3, 2), Array(4, 2), Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), _
Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), _
Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), _
Array(19, 1), Array(20, 1), Array(21, 1), Array(22, 1), _
Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), _
Array(27, 2))
Set ws(1) = ActiveSheet '301在庫.txt
ActiveWindow.FreezePanes = True 'ウィンドウ枠の固定
'
With ws(1)
With .UsedRange.Borders
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
.Rows("1:8").Insert Shift:=xlDown
.Range("D1:AA9").NumberFormatLocal = "@"
End With
'
Set wb1 = Workbooks.Open(Filename:="D:\DATA\サイズ一覧.xls")
wb1.Worksheets(1).Range("B2:W9").Copy 'サイズ一覧.xlsの一つめのシートからコピー
'301在庫.txtのD2にペースト
With ws(1)
.Range("D2").PasteSpecial Paste:=xlPasteValues
.Columns("A:D").AutoFit
End With
Workbooks.OpenText Filename:="D:\DATA\センター別在庫.txt", _
StartRow:=1, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _
Tab:=True, Semicolon:=False, Comma:=True, Space:=False, _
Other:=False, FieldInfo:=Array(Array(1, 2), Array(2, 2), _
Array(3, 2), Array(4, 2), Array(5, 1), Array(6, 1), Array(7, 1))
'
Set ws(2) = ActiveSheet 'センター別在庫.txt
With ws(2)
With .UsedRange.Borders
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
.Columns("A:D").AutoFit
End With
'
Workbooks.OpenText Filename:="D:\DATA\棚在庫.txt", _
StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, _
FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2), _
Array(4, 2), Array(5, 1), Array(6, 1), Array(7, 1), _
Array(8, 2))
Set ws(3) = ActiveSheet '棚在庫.txt
'
With ws(3)
With .UsedRange.Borders
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
.Columns("A:D").AutoFit
.Columns("H").AutoFit
End With
'
Set wb3 = Workbooks.Open(Filename:="D:\DATA\301在庫.xls")
'
For II = 1 To 3
ws(II).Copy before:=wb3.Sheets(II)
With ws(II).Parent
.Saved = True
.Close savechanges:=False
End With
Next
'
'保存します
With wb3 '301在庫.xls
.Save
.Close savechanges:=False
End With
'保存しません
With wb2 'テスト用.xls
.Saved = True
.Close savechanges:=False
End With
'
Erase ws
Set wb1 = Nothing: Set wb2 = Nothing: Set wb3 = Nothing
End Sub
これでもエラーになりますか?
|
|