【先着1,000名様!】1,000円分をプレゼント!

単刀直入にやりたいことを述べます。

Cドライブと仮定します。3つのBOOKがあります。
それぞれ
-----
BOOK1.xls「○○Sheet」・・・(実行するファイル)
  A
1 BOOK2.xls「△△Sheet」・・・(コピーするファイル名の指定です)
2 A2:E2・・・(コピーするセル範囲の指定)
3 BOOK3.xls「□□Sheet」・・・(貼り付け先のファイル名の指定です)
4 A5・・・(貼り付け先のセルの指定)
-----
BOOK2.xls「△△Sheet」・・・(コピー元ファイル)
  ABCDE
1 あいうえお
2 かきくけこ
3 ・・・・・
-----
BOOK3.xls「□□Sheet」・・・(貼り付け先のファイル)
  ABCDE
1 ・・・・・
2 かきくけこ・・・(貼り付け)
3 ・・・・・
-----
>やりたいこと
BOOK1.xls「○○Sheet」のA1のセルの値とA2セルの値を参照し、
その該当BOOKのセル範囲(BOOK2.xls「△△Sheet」のA2:E2)をコピーして、
BOOK1.xls「○○Sheet」のA3のセルの値と、A4セルの値を参照し、
その該当BOOKのセル範囲(BOOK3.xls「□□Sheet」のA5)へペーストする。

別のブックの指定したセルの値を別のブックの指定したセルへ貼り付けるだけなんですが、
以前関数を使って似たような事をしようとしたのですが、うまくいかなかったので、マクロならできるのでしょうか。
よろしくお願いします。(ちなみにエクセル2000又は2003です)

A 回答 (1件)

思われていることと違っていたらすみませんが、参考までに下記のコードをBOOK1.xlsのマクロに貼り付けて実行してみてください。


コピー先のBOOKを壊してはいけないので必ず、コピーしたBOOK等でテストしてみてください。
3つのBOOKがCドライブ直下にあり、BOOK1.xlsの参照するシートのシート名が○○Sheetであることが前提です。

メニューバーの「ツール」→「マクロ」→「マクロ」をクリック
 ↓
マクロのダイアログが表示されたらマクロ名に自由に名前を入力してください。(例:コピーペースト)
 ↓
名前を入力しましたら、「作成」をクリック
 ↓
Microsoft Visual Basicの画面が開きますのでSub コピーペースト()の下に次のコードをコピーして貼り付けてください。

Dim INファイル名 As String
Dim INシート名 As String
Dim IN範囲 As String
Dim OUTファイル名 As String
Dim OUTシート名 As String
Dim OUT範囲 As String
Dim 文字列 As String
Dim 検索文字 As String
Dim 文字カウント As Integer
Dim 文字数 As Integer

'○○SheetのA1にあるファイル名とシート名を取得する
文字列 = Sheets("○○Sheet").Range("A1")
検索文字 = "「"
文字カウント = Application.WorksheetFunction.Find(検索文字, 文字列, 1)
文字カウント = 文字カウント - 1 'ファイル名の文字数を取得
INファイル名 = Left(文字列, 文字カウント) 'INファイル名の取得
文字数 = Len(文字列)
文字カウント = 文字数 - (文字カウント + 1) 'シート名の文字数を取得
文字列 = Right(文字列, 文字カウント)
文字カウント = Len(文字列) - 1
INシート名 = Left(文字列, 文字カウント) 'INシート名の取得
IN範囲 = Sheets("○○Sheet").Range("A2") 'コピーの範囲

'○○SheetのA3にあるファイル名とシート名を取得する
文字列 = Sheets("○○Sheet").Range("A3")
検索文字 = "「"
文字カウント = Application.WorksheetFunction.Find(検索文字, 文字列, 1)
文字カウント = 文字カウント - 1 'ファイル名の文字数を取得
OUTファイル名 = Left(文字列, 文字カウント) 'OUTファイル名の取得
文字数 = Len(文字列)
文字カウント = 文字数 - (文字カウント + 1) 'シート名の文字数を取得
文字列 = Right(文字列, 文字カウント)
文字カウント = Len(文字列) - 1
OUTシート名 = Left(文字列, 文字カウント) 'OUTシート名の取得
OUT範囲 = Sheets("○○Sheet").Range("A4") '貼り付ける位置

'A1のセルの値とA2セルの値を参照しコピー
Workbooks.Open Filename:="C:\" & INファイル名 'INファイルのOPEN
Workbooks(INファイル名).Worksheets(INシート名).Activate
Worksheets(INシート名).Range(IN範囲).Select
Selection.Copy 'コピー
Application.DisplayAlerts = False
ActiveWorkbook.Close savechanges:=False 'INファイルのCLOSE
Application.DisplayAlerts = True

'A3のセルの値と、A4セルの値を参照しペースト
Workbooks.Open Filename:="C:\" & OUTファイル名 'OUTファイルのOPEN
Workbooks(OUTファイル名).Worksheets(OUTシート名).Activate
Worksheets(OUTシート名).Range(OUT範囲).Select
Application.DisplayAlerts = False
ActiveSheet.Paste '貼り付け
Application.DisplayAlerts = True
Application.CutCopyMode = False
Application.DisplayAlerts = False
ActiveWorkbook.Close savechanges:=True 'OUTファイルのCLOSE
Application.DisplayAlerts = True

MsgBox "コピー&ペーストが終了しました。  "
'****コピー貼り付けはここまで ****

Microsoft Visual Basicの画面を×で閉じます
 ↓
Excel画面のメニューバーの「ツール」→「マクロ」→「マクロ」をクリック
 ↓
先ほど名前を付けたマクロを選択して「実行」をクリック

BOOK1.xlsの参照するシート名が○○Sheetでない場合は上記のコードの○○Sheetのところを修正してください。
また、各BOOK*.xlsがCドライブ直下に無い場合は、上記コードの"C:\"のところを修正してください。
    • good
    • 1
この回答へのお礼

こんな長いコードを書いてもらってありがとうございます。

シート名をカギカッコで括って表記してしまったので混乱をまねいたようですね、
最初は自分がカギカッコの意味が判らなかったのですが、
やってみたら、BOOK2.xls「△△Sheet」と
そのまま書くだけでOKだったので出力結果は完璧です。
カギカッコ表記対応になっているのがすごいです。

本当に助かりました。
ありがとうございます。

お礼日時:2008/03/09 23:44

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

QVBAで別エクセルファイルから指定エクセルファイルにシートをコピー

Office2003のエクセルでVBAを勉強しております。

そこで、VBAで別エクセルファイルからあるシートを指定エクセルファイルへ丸まるコピーしたい場合にはどのようにすればよいのでしょうか?

Aベストアンサー

Sheets("A").Copy Before:=Workbooks("Book1").Sheets(1)


>Office2003のエクセルでVBAを勉強しております。

方法が解らなければ、記録マクロを確認するのが一番です。
動作が理解出来たら、コードの最適化を行ってください。

QExel VBA 別ブックから該当データを検索し、必要なデータを取得する方法について

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数ではなく、マクロで処理を希望します。

自分では、部品表の商品番号をコピーして、コード一覧表で検索し、検索結果の右隣のセル(B列のコード)の値を部品表のC列に貼り付ければよいかと思い、書いてみたんですが…

Sub 別ブックから貼り付ける()
  Dim 検索する As Long
Windows("部品表.xls").Activate
検索する = cells(i,2).Value
Windows("コード一覧表.xls").Activate
ActiveWindow.SmallScroll Down:=-3
Selection.AutoFilter Field:=3, Criteria1:="=検索する", Operator:= xlAnd

と、してみたものの、検索しても、その検索結果の隣のセルのコードをどうやって取得すればいいのかが、わかりませんでした。

基本事項は本で学びましたが、呪文のようなコードはよく理解できません。懸命にネットで検索して、訳して理解する努力をしてはいますが。

どうぞよろしくお願いします。

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数...続きを読む

Aベストアンサー

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks.Open("C:\★★\コード一覧表.xls") '★要変更★
 I = 2
 Do While Range("A" & I).Value <> ""
  ThisWorkbook.Worksheets("Sheet1").Range("C" & I).Value = Application.VLookup(ThisWorkbook.Worksheets("Sheet1").Range("B" & I).Value, xlBook.Worksheets("Sheet1").Range("A2:B65535"), 2, 0)
  I = I + 1
 Loop
 xlBook.Close
 Application.ScreenUpdating = True
 MsgBox ("完了")
End Sub

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks....続きを読む

Q異なるブック間でのセル範囲のコピー/VBA

異なるブック間でクリップボードを経由せず直接コピーしたいため
下記のマクロを記述していますが、実行エラーが発生します。
どうしてでしょうか。

ThisWorkbook.Worksheets(3).Range(Cells(3, 1), Cells(3 + a, 1)).Value = Workbooks("excel.xls").Worksheets(1).Range(Cells(11, 3), Cells(11 + a, 3)).Value

(補足)
(1)VBA実行中のThisWorkbook、excel.xlsは別のブック
ですが、同じフォルダにあります。
(2)aは数値が入る変数です。

Aベストアンサー

Cells(3, 1)や他のCellsが参照エラーになるためです。
ブックとワークシートを特定できないためエラーになってしまいます。
正しくは
ThisWorkbook.Worksheets(3).Range(ThisWorkbook.Worksheets(3).Cells(3, 1), _
ThisWorkbook.Worksheets(3).Cells(3 + a, 1)).Value _
= Workbooks("excel.xls").Worksheets(1).Range(Workbooks("excel.xls").Worksheets(1).Cells(11, 3), _
Workbooks("excel.xls").Worksheets(1).Cells(11 + a, 3)).Value

QVBA EXCELファイル選択⇒指定セルコピー

マクロでこんなことできませんか?
完全でなくても構いませんので、できる範囲で教えてください。
宜しくお願いします。

マクロを起動すると、ファイルを選択するウインドウが開きます。ここで、あるExcelファイル(仮にC:\MYDOCUMENT\EXCEL\AAAA.xls)を選択すると、このファイルのセルB2,B3,B4,B5が、マクロを実行しているファイルの同じセルにコピーされ、更にセルB1に、AAAA.xlsの.xlsを抜いた数値のAAAAが入力されます。
AAAA.xlsは一度オープンになってもかまいませんが、自動的に閉じればベターです。

Aベストアンサー

こんにちは。

こんな感じでしょうか。
「ファイルのセルB2,B3,B4,B5」「マクロを実行しているファイルの同じセル」とありますが、複数のシートが存在する可能性があるので、これでは特定出来ません。
取あえず双方ともActiveSheetで処理してます。

Sub Test()
Dim FName, i As Integer
Dim wb As Workbook, pWs As Worksheet
 Set pWs = ThisWorkbook.ActiveSheet
 FName = Application.GetOpenFilename("Excel (*.xls), *.xls")
 If FName = False Then Exit Sub
 Workbooks.Open (FName)
 Set wb = ActiveWorkbook
 pWs.Range("B1") = Left(Dir(FName), Len(Dir(FName)) - 4)
  For i = 2 To 5
   pWs.Range("B" & i) = wb.ActiveSheet.Range("B" & i)
  Next i
 wb.Close
End Sub

こんにちは。

こんな感じでしょうか。
「ファイルのセルB2,B3,B4,B5」「マクロを実行しているファイルの同じセル」とありますが、複数のシートが存在する可能性があるので、これでは特定出来ません。
取あえず双方ともActiveSheetで処理してます。

Sub Test()
Dim FName, i As Integer
Dim wb As Workbook, pWs As Worksheet
 Set pWs = ThisWorkbook.ActiveSheet
 FName = Application.GetOpenFilename("Excel (*.xls), *.xls")
 If FName = False Then Exit Sub
 Workbooks.Open (FName)
 S...続きを読む

QEXCEL VBA で現在開いているブックのファイル名を取得する方法

EXCEL2003 VBAで業務を簡素化するために、現在開いているブックのファイル名を取得する方法が分かりません。
作業手順をマクロを使って処理していますが、オリジナルのワークブックをファイル名を変えて保存し、以後、このワークブックを読み込んで使用しています。
このときのVBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり、以後の業務に使用できません。
常にファイル名を取得出来るVBAをどなたか、教えて下さい。

Aベストアンサー

>現在開いているブックのファイル名
 ちょっと曖昧な表現かなぁという気もいたしますが、VBAが書いてあるブックのブック名は
ThisWorkbook.Name
で、現在 "アクティブにして" 操作対象になっているブックの名前は
ActiveWorkbook.Name
ですね。

 しかし、
>VBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり
というような文脈からすると、
ThisWorkbook.Name
の方ですかね。

QEXCEL VBAマクロ作成で、他のEXCELからデータを取り込みたい

メインプログラム(EXCEL VBA)より、
他のフォルダーにあるEXCELの項目の内容を取り込みたいです。
たとえば他のフォルダーのEXCELのRange("A2:A3").ValueをメインプログラムのRange("C2:C3").Valueにセットしたい時です。

・コマンドボタン押したら、どこのEXCELから取り込むかのポップアップ(?)は、表示はできてます。
・作業者が選んだパスとブックもMsgBoxで表示できてるので、もらう相手の場所も取得できてます。

・となると次はOPEN,INPUTですか?
テキストデータの取り込みですと、Inputでそのバッファを定義してるのですが、なんか違うような。。。

よろしくお願いします!

Aベストアンサー

私がやる方法です。

Dim writeSheet As Worksheet ' 自分自身の書き出し先シート
Set writeSheet = ThisWorkbook.Worksheets(1) ' Sheet1 を参照

Dim readBook As Workbook ' 相手ブック
Set readBook = Workbooks.Open(filename) ' 相手ブックを開いて参照
Dim readSheet As WorkSheet ' 相手シート
Set readSheet = readBook.Worksheets("sheetName") ' 相手シートを参照
' または Set readSheet = readBook.Worksheets(sheetIndex)

' 例えば
writeSheet.Cells(1, 1).Value = readSheet.Cells(2, 2).Value ' 相手シートの B2 の値を自分自身の A1 に書き込む

readBook.Close False ' 相手ブックを閉じる
Set readSheet = Nothing
Set readBook = Nothing

私がやる方法です。

Dim writeSheet As Worksheet ' 自分自身の書き出し先シート
Set writeSheet = ThisWorkbook.Worksheets(1) ' Sheet1 を参照

Dim readBook As Workbook ' 相手ブック
Set readBook = Workbooks.Open(filename) ' 相手ブックを開いて参照
Dim readSheet As WorkSheet ' 相手シート
Set readSheet = readBook.Worksheets("sheetName") ' 相手シートを参照
' または Set readSheet = readBook.Worksheets(sheetIndex)

' 例えば
writeSheet.Cells(1, 1).Value = readSheet.Ce...続きを読む

QエクセルのVBAで、異なるブック間でのコピー&ペースト

こんばんは。

エクセルのVBAで、異なるブック間でのコピー&ペーストに関しての質問です。


現在アクティブになっているシートのB4セルをコピーして、
現在開いているシートのブックとは異なる特定の
ブック(”Book1")の特定のシート(”Sheet1”)のC5セルに貼り付けたい場合、
●●●の部分に何と表現すればよいか教えてください。


Range("B4").Copy Destination:=●●●


よろしくお願いいたします。

Aベストアンサー

同じインスタンスのExcelで開いているブックなら
Range("B4").Copy WorkBooks("Book2".WOrksheets("Sheet1").Range("C5")
といった具合で指定しましょう

Q【Excel VBA】データ貼り付け先のシート名選択

Excel2003を使用しています。

あるシートの選択部分を別のシートに値のみコピーするという作業をマクロで処理したく、コードを書きました。
コピー元のシートは毎回同じなのですが、貼り付け先のシートは、都度選択するようにしたいので、InputBox にシート名を入力して選択する方法にしていますが、これをシート名リストから選択するようにすることは可能でしょうか?
可能であれば、その方法を教えていただきたいのですが。。。

よろしくお願いします。

Aベストアンサー

こんにちは。

Userform 不要でシート選択ダイアログを表示する方法です。

Excel 組み込みダイアログではあるのですが、通常の方法
Dialogs().Show ではシート選択ダイアログは表示できませんし、
そもそも Dialogs は戻り値がありません。

そこで、ちょっとトリッキーな手法を使ってシートオブジェクト
を返す関数にしてます。

Sub Sample()
  Dim Sh As Worksheet
  Set Sh = ShowSelectSheetDialog()
  If Not Sh Is Nothing Then
    MsgBox Sh.Name & "が選択されました。アクティブにします(・∀・)", _
        vbInformation
    Sh.Activate
  Else
    MsgBox "キャンセルされましたよ(・∀・)", vbExclamation
  End If
  Set Sh = Nothing
End Sub

' // シート選択ダイアログを表示
' // 戻り値: 選択されたシートオブジェクト キャンセル時:Nothing
Public Function ShowSelectSheetDialog() As Worksheet
  
  Dim ShBackup As Worksheet
  Application.ScreenUpdating = False
  Set ShBackup = ActiveSheet
  With CommandBars.Add(Temporary:=True)
    .Controls.Add(ID:=957).Execute
    .Delete
  End With
  ' Return
  If Not ActiveSheet Is ShBackup Then
    Set ShowSelectSheetDialog = ActiveSheet
  End If
  ShBackup.Select
  Application.ScreenUpdating = True

End Function

こんにちは。

Userform 不要でシート選択ダイアログを表示する方法です。

Excel 組み込みダイアログではあるのですが、通常の方法
Dialogs().Show ではシート選択ダイアログは表示できませんし、
そもそも Dialogs は戻り値がありません。

そこで、ちょっとトリッキーな手法を使ってシートオブジェクト
を返す関数にしてます。

Sub Sample()
  Dim Sh As Worksheet
  Set Sh = ShowSelectSheetDialog()
  If Not Sh Is Nothing Then
    MsgBox Sh.Name & "が選択されました。アクテ...続きを読む

Qエクセル:マクロ「Application.CutCopyMode = False」って?

エクセルのマクロを記録していると

「Application.CutCopyMode = False」

というものがよく出てきますが、これは何でしょう?
どういう意味のものかわかりません。
削除しても差し支えないのもでしょうか?

Aベストアンサー

「Application.CutCopyMode = False」の前で
セルのコピー、または切り取りを行っていると思います。
これは、その操作(セルのコピー、または切り取り)を無効にしているだけです。
------------
Range("A1").Select
Selection.Copy ← これを無効にしている
Range("A2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
------------
上記の場合であれば、「Application.CutCopyMode = False」を削除しても問題ありませんが、
以下の場合、貼り付け処理でエラーになります。
------------
Range("A1").Select
Selection.Copy
Range("A2").Select
Application.CutCopyMode = False
ActiveSheet.Paste ← ココでエラー
------------
ご自分で、セルをコピーしてみると分かると思いますが、コピーした範囲が点線で点滅されます。
「Application.CutCopyMode = False」をすると、
その点滅がなくなります。

「Application.CutCopyMode = False」の前で
セルのコピー、または切り取りを行っていると思います。
これは、その操作(セルのコピー、または切り取り)を無効にしているだけです。
------------
Range("A1").Select
Selection.Copy ← これを無効にしている
Range("A2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
------------
上記の場合であれば、「Application.CutCopyMode = False」を削除しても問題ありませんが、
以下の場合、貼り付け処理でエラーになります。
------------
...続きを読む

Qエクセルで、条件に一致した行を別のセルに抜き出す方法

エクセルで、指定した条件に一致するセルを含む行をすべて抜き出す方法が知りたいです。

たとえば、

<A列> <B列> <C列>
7/1 りんご 100円
7/2 ぶどう 200円
7/2 すいか 300円
7/3 みかん 100円

このような表があって、100円を含む行をそのままの形で、
別のセル(同じシート内)に抜き出したいのですが。

7/1 りんご 100円
7/3 みかん 100円

抽出するだけならオートフィルターでもできますが、
抽出結果を自動的に、別の場所に、常に表示させておきたいのです。

初歩的な質問だと思いますが、検索しても分からなかったので、よろしくお願いします。

Aベストアンサー

同じ質問が結構よく出てますが、そんなに初歩的でもありません
別シートのA1セルに「100円」と入力し、そのシートの任意のセルに以下の式を貼り付けて下さい。後は、下方向、右方向にコピー。
日付のセル書式は「日付」形式に再設定してください

=IF(COUNTIF(Sheet1!$C:$C,$A$1)>=ROW(A1),INDEX(Sheet1!A:A,LARGE(INDEX((Sheet1!$C$1:$C$500=$A$1)*ROW(Sheet1!$C$1:$C$500),),COUNTIF(Sheet1!$C:$C,$A$1)-ROW(A1)+1)),"")

データ範囲は500行までとしていますが、必要に応じて変更して下さい


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング