[[20080827123359]]　『VBAで他のフォルダーにあるファイルを参照したい』（けーこ）　ページの最後に飛ぶ

『VBAで他のフォルダーにあるファイルを参照したい』（けーこ）

"有休チェック.xls"というものを作ってそこに他のフォルダーにある"中山.xls"の"月"の部分をコピーするマクロを自動記録で作ろうとしましたがうまくいきません。
マクロの記録では次のように出ましたが最初の１行目をC:\総務\有休\中山.xlsのなかのシート"１月"を参照するように変更したいのですが分かりません。よろしくご教示お願いいたします。

Sub 中山有休１月コピー()

Application.WindowState = xlMinimized

   Sheets("１月").Select
   Range("O7:Q39").Select
   Selection.Copy
   Windows("有休チェック.xls").Activate
   ActiveWindow.SmallScroll Down:=-15
   Range("B7").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
   SkipBlanks:=False, Transpose:=False
   ActiveWindow.SmallScroll Down:=12
End Sub

 中山.xlsが開かれている状態から、記録されていると、推測しますが、
ブックを特定する動作が入っていないので、   Sheets("１月").Select
ではアクティブなブックに１月というシートがあるとそれが対象に
なってしまいますね。
　
有給チェック.xlsだけを開いた状態から記録を開始し、
中山.xlsを開く
１月シート以外のシートを一度選択する。
１月シートを選択する
コピー、貼り付け、
中山.xlsを閉じる
という動作を記録してみてはいかがでしょうか。
(みやほりん)(-_∂)b

 「中山.xls」が開いてあったり、なかったりすると厄介なので、
 セルに数式を入力して、数式の力で中山のセル値を参照し、その後、数式を値に変えたらどうかなと思います。

 Sub Sample()
    Windows("有休チェック.xls").Activate
    Range("B7:C39").Formula = "='C:\総務\有休\[中山.xls]1月'!O7"
    Range("B7:C39").Value = Range("B7:C39").Value
 End Sub

  （半平太）

 自分で実験してみましたら、未入力セルが「0」に変化することに気が付きました。（トホホ）
 このため　これに変更してみてください。
 　　　　　↓
 Sub TEST()
    Windows("有休チェック.xls").Activate
    Range("B7:C39").Formula = "=IF('C:\総務\有休\[中山.xls]1月'!O7="""","""",'C:\総務\有休\[中山.xls]1月'!O7)"
    Range("B7:C39").Value = Range("B7:C39").Value
 End Sub

  （半平太）

これから試してみたいと思います。皆様いろいろありがとうございました。

説明が悪かったと思います。うまくいきませんでしたので再度質問させてください。「有休チェック.xls」が選択され、その中には各人ごとに５０位のシートがありいま「奥津」のB7:D39が選択されている状態です。開かれているものはこのシートだけでそこから記録を開始しました。記録は次のとおりです。
' 奥津有休チェック_Click Macro
' マクロ記録日 : 2008/8/29 ユーザー名 : ＯＺＡＫＩ．ｋ
'

    ActiveWindow.SmallScroll Down:=-39
    Sheets("２００８年１月").Select
    ActiveWindow.SmallScroll Down:=-33
    Range("G7:I39").Select
    Selection.Copy
    Application.WindowState = xlMinimized
    Windows("有休チェック.xls").Activate
    ActiveWindow.SmallScroll Down:=-36
    Range("B7:D39").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub
順序は
①エクスプローラーを開始「有休ホルダー」のなかの「有休管理表」を開く
②その中の「奥津.xls」を開きそこでG7:I39を選択する
③右クリックでコピー
④｢有休チェック.xls」の「奥津」へ行きそのC7:D39を形式を選択して貼り付け→値→OK
でやりましたが、きろくされているものには、上のステップ①②がでてきません。
どのようにしたらよろしいでしょうか再度ご教示お願いいたします。

けーこ

 こんな感じでしょうか？

 Sub test() 
 Dim fn As String, wb As Workbook

 '①エクスプローラーを開始「有休ホルダー」のなかの「有休管理表」を開く
 fn = Application.GetOpenFileName("Excel,*.xls")

 ' ②その中の「奥津.xls」を開きそこでG7:I39を選択する
 ' ③右クリックでコピー
 Set wb = Workbooks.Open(fn)
 wb.Sheets("２００８年１月").Range("G7:I39").Copy

 ' ④｢有休チェック.xls」の「奥津」へ行きそのC7:D39を形式を選択して貼り付け→値→OK
 ThisWorkbook.Sheets("奥津").Range("c7").PasteSpecial xlPasteValues  '<- 修正
 wb.Close False
 Set wb = Nothing
 End Sub
 (seiya)

早速のご返事ありがとうございました。大変勉強になっております。なにかあったら又お願いいたします。　ケー子

 一行修正しました。

 旧:
  ThisWorkbook.Sheets("1").Range("c7").PasteSpecial xlPasteValues
 新:
  ThisWorkbook.Sheets("奥津").Range("c7").PasteSpecial xlPasteValues

 (seiya)

蒸し返しでごめんなさい。現在以下のように作って便利に使っています。

 　
Workbooks.Open Filename:="C:\有休管理表2\奥津.xls", UpdateLinks:=0
Sheets("２００８年９月").Select
 Range("G7:I39").Select
    Selection.Copy
    Windows("有休チェック.xls").Activate
    Sheets("小川").Select
    Range("Q7:S39").Select
    Application.DisplayAlerts = False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("R25").Select
    'Application.DisplayAlerts = False
    ActiveWindow.SmallScroll Down:=15
End Sub
　
これをファイルが既に開かれている場合にも対応でるようにしたいのですがうまくいきません。
自分なりに以下のようにつくりましたがコンパイルエラー Sub またはFunctionが定義されていないとでます。
どのようにすればよいのかご教示下さい。
　
Sub 奥津9月参照_Click()
　
If IsFileOpen("C:\有休管理表2\奥津.xls") Then
　
Sheets("２００８年９月").Select
　
Else Workbooks.Open Filename:="C:\有休管理表2\奥津.xls", UpdateLinks:=0
Sheets("２００８年９月").Select
 Range("G7:I36").Select
    Selection.Copy
    Windows("有休チェック.xls").Activate
    Sheets("奥津").Select
    Range("V7:X36").Select
    Application.DisplayAlerts = False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("X25").Select
    'Application.DisplayAlerts = False
    ActiveWindow.SmallScroll Down:=15
　    
End If
End Function
　
宜しくお願いいたします。

最後はEnd Subです。すみません。

 IsFileOpen の Function プロシジャはどうなっているのでしょうか？
 (ROUGE)

コメント返信：

[ 一覧(最新更新順) ]

[[20080827123359]] 『VBAで他のフォルダーにあるファイルを参照したい』（けーこ） ページの最後に飛ぶ

[[20080827123359]]　『VBAで他のフォルダーにあるファイルを参照したい』（けーこ）　ページの最後に飛ぶ