|
りんさん、こんにちは。
形がだんだんと出来てきました。
下記のりんさんのご質問に答えますと。。。。
テスト用.xlsのファイルを開いたと同時にマクロを起動させるようにしています。
Private Sub Workbook_Open()を使って・・
そしてサイズ一覧.xlsのペースト先は301在庫.txtです。
そのあと、【301在庫.txt】【センター在庫.txt】【棚在庫.txt】を
テスト用.xlsにシート別にペーストします。
(ちなみにテスト用.xlsのシート名は、301在庫、センター別在庫、棚在庫です。)
そしてテスト用.xlsに貼り付けたものを、そのまま【301在庫.xls】
にコピー、ペーストします。
昔の私のマクロですと、普通に思ってるように流れるのですが、
テスト用.xlsから自動起動するとどうもとまってしまって。。。
でもりんさんのやりかたですと、自動起動してもとまりません。すごい!
ただコピー、ペースト方法がちょっとわからないのですが。。。
お時間がありましたらよろしくお願い致します。
>>マクロブック テスト用.xls
>>テキストファイルの名前
>>【301在庫.txt】
>>【センター別在庫】
>>【棚在庫】
>
>
>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
> '
> 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
> '↓ここがよくわからないので保留(ペースト先は301在庫.txt?)
> Set wb1 = Workbooks.Open(Filename:="D:\DATA\サイズ一覧.xls")
> Range("B2:W9").Copy
> ActiveWindow.WindowState = xlMinimized
> With ActiveWindow
> .Top = 4
> .Left = 8.5
> End With
> Range("D2").Select
> ActiveSheet.Paste
> '
> Columns("A:D").AutoFit
> Range("E10").Select
> ActiveWindow.FreezePanes = True
> '↑ここまでよくわからない。
> 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 wb2 = Workbooks("テスト用.xls") 'いつ開いたの?
> Set wb3 = Workbooks.Open(Filename:="D:\DATA\301在庫.xls")
> '
> For II = 1 To 3
> ws(II).Copy before:=wb2.Sheets(II)
> ws(II).Copy before:=wb3.Sheets(II)
> With ws(II).Parent
> .Saved = True
> .Close savechanges:=False
> End With
> Next
> '
> '保存していいのかな?
> '
> 'With wb2 'テスト用.xls
> ' .Save
> ' .Close savechanges:=False
> 'End With
> 'With wb3 '301在庫.xls
> ' .Save
> ' .Close savechanges:=False
> 'End With
> '
> Erase ws
> Set wb1 = Nothing: Set wb2 = Nothing: Set wb3 = Nothing
>End Sub
>
>エラーになりますか?
|
|