Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


10871 / 13644 ツリー ←次へ | 前へ→

【19438】ファイルの操作について 初心者 04/11/3(水) 0:36 質問[未読]
【19443】Re:ファイルの操作について Kein 04/11/3(水) 14:04 回答[未読]
【19445】Re:ファイルの操作について 初心者 04/11/3(水) 15:30 お礼[未読]

【19438】ファイルの操作について
質問  初心者  - 04/11/3(水) 0:36 -

引用なし
パスワード
   はじめまして。いつも参考にさせて頂いています。

部品表のEXCELファイルが8とモデル表のEXCELファイルが10〜15あります。
部品表の100程度あるパーツから必要なものに"1"をたててオートフィルタで指定のモデル表ファイルに貼り付けるマクロを作りました。モデル名はあるセルの値を代入してあります。
私の作ったマクロはモデル表を一緒に開いていることが条件なのですが、もし開いていなければ”モデル名(変数)を開きますか?"のメッセージのあと指定したモデル表を開いて貼り付けるマクロに修正をしたいのですが、うまくいきません。
はじめから開いて貼り付けるマクロにしない理由は部品表が8あり、同じ処理をすべての部品表で行うため、後者だといちいちモデル表を閉じる必要があるからです。下が作ったマクロです。
ご指導よろしくお願いします。

Sub 集計ファイルに出力()

 Dim 列 As Long
 Dim モデル名 As String
 Dim mybtn As Integer
 Dim 行 As Long
 
 行 = Range("K65536").End(xlUp).Row
 列 = ActiveCell.Column
 モデル名 = ActiveCell.Value
 
 mybtn = MsgBox(("モデル " & モデル名 & " を出力します"), 1)
 If mybtn = 2 Then
 Exit Sub
 Else
 End If
 
  Application.ScreenUpdating = False
  Rows("6:6").Select
  Selection.AutoFilter
  Selection.AutoFilter Field:=列, Criteria1:="<>"
  Rows("2:400").Select
  Range("A8", "K" & 行).Select
  Selection.SpecialCells(xlCellTypeVisible).Select
  Selection.Copy
  Windows(モデル名 & ".xls").Activate
  Worksheets("AAA").Select
  Range("A8").Select
  ActiveSheet.PasteSpecial
  Selection.AutoFilter
  Windows("AAA.xls").Activate
  Application.CutCopyMode = False
  Application.ScreenUpdating = True
  Selection.AutoFilter
  Windows(モデル名 & ".xls").Activate
  Selection.AutoFilter
End Sub

【19443】Re:ファイルの操作について
回答  Kein  - 04/11/3(水) 14:04 -

引用なし
パスワード
   Sub 集計ファイルに出力()
  Dim WB As Workbook
  Dim Ck As Boolean
  Dim 行 As Long, 列 As Long
  Dim モデル名 As String
  Dim mybtn As Integer
 
  行 = Range("K65536").End(xlUp).Row
  列 = ActiveCell.Column
  モデル名 = ActiveCell.Value
  mybtn = MsgBox("モデル " & モデル名 & " を出力します")
  If mybtn = 2 Then Exit Sub
  For Each WB In Workbooks
   If LCase(WB.Name) = モデル名 & ".xls" Then
     Ck = True: Exit For
   End If
  Next
  Application.ScreenUpdating = False
  If Ck = False Then
   Workbooks.Open ThisWorkbook.Path & "\" & モデル名 & ".xls"
   ThisWorkbook.Activate
  End If
 
概ね、このような書き出しでよいと思います。他にはエラートラップするやり方も
ありますが。

【19445】Re:ファイルの操作について
お礼  初心者  - 04/11/3(水) 15:30 -

引用なし
パスワード
   Keinさん

ちゃんと動作しました。他にもいろいろ応用出来そうです。
ありがとうございました!!

▼Kein さん:
>Sub 集計ファイルに出力()
>  Dim WB As Workbook
>  Dim Ck As Boolean
>  Dim 行 As Long, 列 As Long
>  Dim モデル名 As String
>  Dim mybtn As Integer
> 
>  行 = Range("K65536").End(xlUp).Row
>  列 = ActiveCell.Column
>  モデル名 = ActiveCell.Value
>  mybtn = MsgBox("モデル " & モデル名 & " を出力します")
>  If mybtn = 2 Then Exit Sub
>  For Each WB In Workbooks
>   If LCase(WB.Name) = モデル名 & ".xls" Then
>     Ck = True: Exit For
>   End If
>  Next
>  Application.ScreenUpdating = False
>  If Ck = False Then
>   Workbooks.Open ThisWorkbook.Path & "\" & モデル名 & ".xls"
>   ThisWorkbook.Activate
>  End If
> 
>概ね、このような書き出しでよいと思います。他にはエラートラップするやり方も
>ありますが。

10871 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free