• ベストアンサー
  • すぐに回答を!

Excel マクロ 別ブックの情報をコピーする方法

他のブックの情報をコピーして貼り付けるマクロを作成しています。 2種類のブックから情報をコピーして貼り付けます。 Sub MailTemp() Dim myCellall As Range Dim myCellyoso As Range Dim myCellfor As Range Set myCellall = Sheets("すべて").Range("A3") With Workbooks.Open("\") With .Worksheets("すべて") .Range(.Range("A3"), .Cells.SpecialCells(xlCellTypeLastCell)).Copy myCellall End With .Close False End With Set myCellyoso = ThisWorkbook.Worksheets("予測").Range("A3") Set myCellfor = ThisWorkbook.Worksheets("結果").Range("A3") With Workbooks.Open("\別ブック") With .Worksheets("予測") .Range(.Range("A3"), .Cells.SpecialCells(xlCellTypeLastCell)).Copy myCellyoso End With With .Worksheets("結果") .Range(.Range("A3"), .Cells.SpecialCells(xlCellTypeLastCell)).Copy myCellfor End With .Close False End With End Sub 下記の箇所でエラーが発生して、先に進みません。 原因を調べていましたが、わかりません。 Set myCellfor = ThisWorkbook.Worksheets("結果").Range("A3") エラーメッセージ 実行時エラー'9' インデックスが有効範囲にありません。 アドバイスを頂けますでしょうか。 よろしくお願いいたします。

共感・応援の気持ちを伝えよう!

  • 回答数2
  • 閲覧数1755
  • ありがとう数7

質問者が選んだベストアンサー

  • ベストアンサー
  • 回答No.2

こんばんは ThisWorkbook は、マクロのあるワークブック。 ActiveWorkbook は、現在アクティブになっているワークブック。 という区別のうえでのコードでしょうか? Worksheets("結果")のあるワークブックが"別ブック"だとすると、 Workbooks("別ブック").Activate としたうえで、 Set myCellfor = ActiveWorkbook..Worksheets("結果").Range("A3") という感じで、OKと思いますし、 アクティブにしようがしまいがということであれば、 Set myCellfor = Workbooks("別ブック").Worksheets("結果").Range("A3") という風でしょう。 ご紹介のコードを見る限り、Worksheets("予測").は、ThisWorkbook で、 貼り付け先のWorksheets("結果")は、ThisWorkbook とは違うワークブックでしょう。 'ThisWorkbook' の'This' は、With 構文の指すものではなくて、コードのあるワークブックです。 承知の上だとすると、原因は全く違うところにありそうですが、いかがでしょうか?

共感・感謝の気持ちを伝えよう!

質問者からのお礼

ご回答ありがとうございました。ThisWorkbookを理解していませんでした。再度見直ししてマクロが作成できました。

その他の回答 (1)

  • 回答No.1
  • keithin
  • ベストアンサー率66% (5278/7939)

>Set myCellfor = ThisWorkbook.Worksheets("結果").Range("A3") >実行時エラー'9' インデックスが有効範囲にありません。 「すべて」と「予測」シートはありますが,「結果」シートがありません。 そもそも無ければ勿論アウトですが,あるいは「結果□」(□はスペース)など,間違ったシート名になっているのかもしれません。シート名を付け直してみてください。

共感・感謝の気持ちを伝えよう!

質問者からのお礼

ご回答ありがとうございました。シート名が異なるところがありました。修正しマクロを完成しました。

関連するQ&A

  • Excel マクロ 別のファイルの情報をコピーして貼り付ける

    Excel 2007のマクロで、別のファイルの情報をコピーして貼り付ける マクロを作成しています。 別ファイルが1つであれば下記のマクロでできました。 他に別ファイルがもう1つあり、全部で2つのファイルからそれぞれ 必要なシートから情報をコピーしたいと思います。 ※各シート名は異なります。 別ファイルが2つになった場合、マクロをどのように記載すればよろしいでしょうか。 よろしくお願いいたします。 Sub Test1() Dim myCellall As Range Set myCellall = Sheets("すべて").Range("A1") With Workbooks.Open("\") With .Worksheets("すべて") .Range(.Range("A1"), .Cells.SpecialCells(xlCellTypeLastCell)).Copy myCellall End With .Close False End With End Sub

  • Excel マクロ 他ブックのシートの範囲選択した内容を別ブックのシートにコピーする方法

    他ブックのシートの範囲を選択しコピーした内容を、別ブックのシート に貼り付けするマクロを作成しています。 現在の情報であれば、下記のマクロで解決できます。 Sub Test1() Dim myCellall As Range Dim myCellsom As Range Dim myCelluri As Range   Set myCellall = Sheets("すべて").Range("A1") Set myCellsom = Sheets("総務").Range("A1") Set myCelluri = Sheets("売上").Range("A1") With Workbooks.Open("\") .Worksheets("すべて").Range("A1:K17").Copy myCellall .Worksheets("総務").Range("A1:K88").Copy myCellsom .Worksheets("売上").Range("A1:K81").Copy myCelluri .Close False End With End Sub ただ、他ブックのシートのデータは変動するため、行と列の変更を行わなければいけません。行と列の増減があっても、自動的に対応できるマクロを書きたいと思います。 どのようなマクロを追加すればよろしいでしょうか。 よろしくお願いいたします。

  • Excel 2007 マクロ 別ブックのシートをコピーする方法

    Excel 2007 マクロ 別ブックのシートをコピーする方法 別ブックのシートをコピーして アクティブなブックのシートにコピーしたいと思います。 下記マクロを作成しました。 貼り付ける際に、クリップボードに保存するかどうか 聞かれるメッセージが表示されてうまくいきません。 またもっとシンプルな書き方があればアドバイスお願いします。 Sub 取り込み() Dim wb As Workbook Set wb = Workbooks.Open("\") Sheets("Sheet1").Select Cells.Select Selection.Copy ThisWorkbook.Activate ThisWorkbook.Sheets("特定").Select ActiveSheet.Cells(1, 1).Select ActiveSheet.Paste wb.Close End Sub

  • EXCEL 別シートのコピー(3)

    こんにちは。 こちらで以前こちらで質問をさせていただき、EXCELの別ブックのシートからコピーをしています。 元のブックのコピーを作り、そこに入力してもらい、元のブックにコピーをしています。(同じフォルダに入れて) Private Sub CommandButton1_Click() Dim myBook As Workbook Set myBook = Workbooks.Open(ThisWorkbook.Path & "\コピー元ブック.xls")  with workbooks("コピー元ブック.xls").worksheets("シート名").usedrange workbooks("貼り付け先ブック.xls").worksheets("シート名").range(.address).value = .value end with end sub ここでブックがない場合、そのブックを飛ばしてあるブックだけコピーしたい場合は、どうしたらいいでしょうか。いろいろやってみましたが、コピーできませんでした。 教えてください。

  • Excel VBAで検索結果を新規ブックにコピー

    Excel VBAの質問です。 コンボボックスで選択した文字列とSheet1のC列の文字列が一致したら、 その行を新規ブックのSheet1にコピーしたいのですが、うまくできません。 新規ブックは開くのですが、データはコピーされていません。 既存ブックのSheet2にはコピーできるので、たぶん、新規ブックのSheet1へコピーという 命令がうまくかけていないのだと思います。 書籍やネットで調べてもよく分かりませんでした。 大変困っているので、どなたかご教授ください。よろしくお願いします。 元のSheet1は以下のようにデータが入力されています。 例えば、コンボボックスで「めがね」と選択されたら、1,4,5行目のC列と一致するので それらの行を新規ブックにコピーしたいのです。 A B C D ----------------------------- 1|10 10:00 めがね 保管中 2|11 12:00 衣服  倉庫 3|12 13:00 自転車 保管中 4|13 11:00 めがね 保管中 5|14 13:00 めがね 倉庫 Private Sub Search_Click() Dim SearchWord As String Dim gyou As Long Dim word As String Dim LastRow As Long Dim count As Integer Dim baseBook As Workbook Dim newBook As Workbook Dim baseSheet As Worksheet Dim newSheet As Worksheet SearchWord = cmbsSyutokubutu_search.Text Set baseBook = ThisWorkbook Set baseSheet = baseB.Worksheets("Sheet1") baseSheet.Activate With Worksheets("Sheet1") count = 0 gyou = 4 LastRow = baseSheet.Cells(Rows.count, 5).End(xlUp).Row Set newB = Workbooks.Add Set newS = newBook.Worksheets("Sheet1") Do While Cells(gyou, 3) <> "" word = Cells(gyou, 3) If InStr(word, SearchWord) >= 1 Then Rows(gyou).Copy newBook.Cells(Rows.count, 1).End(xlUp).Offset(1, 0) End If gyou = gyou + 1 Loop End With End Sub

  • 【マクロ】値貼り付けに変更するには…?

    当方Excel2003です。 ○フォルダ内に入力用のブック(複数)とまとめ用ブック(一つ)が存在し ○すべてのブックにはシートが一つしかなく、タイトル行の位置はまとめブック含めすべて同じ構成である ○入力用ブックのシート名は「入力」、まとめ用ブックのシート名は「まとめ」である 前提で、入力用ブックのデータ入力域をまとめ用ブックに順次コピーをしようと作成中のものですが、 以下の構文 Set c = .Range("B" & .Rows.Count).End(xlUp).Offset(1) あるいは With .Worksheets(入力).Range("B3:H3" & Range("H65532").End(xlUp).Row).Copy Destination:=c の部分について コピー貼り付け(そのまま)ではなく、 「値のみの貼り付け」に変更するには? どういうふうに変更したら良いのか どなたかご教示いただければ幸いです。 よろしくお願いいたします。 Sub 連続貼り付け() Dim sFile As String Dim c As Range Dim myPAth As String Application.ScreenUpdating = False sFile = Dir(ThisWorkbook.Path & "\*.xls", vbNormal) myPAth = ThisWorkbook.Path Do While 0 < Len(sFile)      With ThisWorkbook.Worksheets("まとめ")       Set c = .Range("B" & .Rows.Count).End(xlUp).Offset(1)      End With     Select Case sFile        Case ThisWorkbook.Name:        Case Else          With Workbooks.Open(Filename:=myPAth & "\" & sFile, ReadOnly:=True)              With .Worksheets(入力)                  .Range("B3:H3" & Range("H65532").End(xlUp).Row).Copy Destination:=c              End With             .Close SaveChanges:=False          End With      End Select      sFile = Dir()      Set c = Nothing   Loop   Application.ScreenUpdating = True   End Sub

  • エクセルのVBAの記述について

    VBAの記述についてなのですが、 Sub filter() Dim gyo As Long Dim ws1 As Worksheet Dim ws2 As Worksheet Dim ws3 As Worksheet Set ws1 = Worksheets("データ") Set ws2 = Worksheets("チーム") Application.ScreenUpdating = False ws2.Range("A4:BH30").Clear gyo = ws1.Range("A65536").End(xlUp).Row ws1.Activate With ws1.Range(Cells(4, 1), Cells(gyo, 6)) .AutoFilter Field:=1, Criteria1:="A" .SpecialCells(xlCellTypeVisible).Copy ws2.Range("A4") Selection.AutoFilter End With Application.ScreenUpdating = True End Sub ならプログラムははしるのですが、 14行目を .SpecialCells(xlCellTypeVisible).Copy ws2.Range(Cells(4, 1)) だと 「実行時エラー 1004 Rangeメソッドは失敗しました Worksheet オブジェクト」 とでるのですが、出来ないのでしょうか? Cells(4, 1)の1のところを変数にして変えていきたいのですが、よい方法はありますか。 よろしくお願いいたします。

  • 複数のエクセルシートをまとめるマクロ

    下は複数のエクセルファイルを一つにするマクロですが、100万件を超えるためcsvで保存するようにするにはどこを変更したらよいでしょうか。 よろしくお願いします。 Sub Sample() Dim t As Single Dim strPath As String Dim strFileName As String Dim WB1 As Workbook Dim WS1 As Worksheet Dim WS2 As Worksheet Dim lngRowCount As Long 'A列に値が入っているデータ数 t = Timer 'まとめたいシート Set WS2 = ThisWorkbook.Worksheets(1) strPath = ThisWorkbook.Path strFileName = Dir(strPath & "\*.xls*") Do While strFileName <> "" If strFileName <> ThisWorkbook.Name Then Set WB1 = Workbooks.Open(strPath & "\" & strFileName) Set WS1 = WB1.Worksheets(1) With WS1.Range("A1") lngRowCount = .Worksheet.Cells(.Worksheet.Rows.Count, .Column).End(xlUp).Row - .Row If lngRowCount >= 1 Then With .Resize(lngRowCount, 14).Offset(1) .Copy WS2.Range("A" & WS2.Rows.Count).End(xlUp).Offset(1) End With End If End With WB1.Close False End If strFileName = Dir Loop MsgBox "まとめ処理をしました。処理時間 " & Format((Timer - t) / 60 / 60 / 24, "h:mm:ss") End Sub

  • 他ブックから指定範囲をコピー

    自分で調べたのですがよく分からないので質問します。 下のように書いたのですが 実行時エラー '424'; オブジェクトがッ必要です。というエラーが出ます。 Private Sub CommandButton3_Click() Dim F_Name As String, myRange As Range F_Name = Application.GetOpenFilename("Microsoft Excelブック,*.xls") If F_Name <> "False" Then Workbooks.Open F_Name With ActiveWorkbook Set myRange = .Worksheets(1).Range("B6:U509") .Saved = True .Close End With With ThisWorkbook myRange.Copy.Worksheets(2).Range ("B6:U509") End With End If Set myRange = Nothing End Sub やりたいことは読み込んだExcelのシート1(または金額というシート)のB6:U509範囲をコピーし 実行したブックのシート2(または金額というシート)のB6:U509範囲に貼り付けたいのです。 よろしくお願いします

  • ブック内に特定名のシートがある場合

    はじめまして、こんにちは。 VBAを最近はじめたばかりの者です。質問が初歩的なもので申し訳ないのですが是非教えてください。 以下を使って、複数ブックの○○というシートから指定セルの内容を抜き出したいと思っています。 ところが、ブックによっては○○というシートが存在しない場合があり、その場合には「インデックスが有効でない」というエラーで動作が止まってしまいます。 ブック内に○○というシートがある場合にのみ動作させるようにするにはどのようにすれば良いのでしょうか。 よろしくお願いします。 Dim wb As Workbook, myRow As Long Dim e As Integer myRow = ThisWorkbook.Worksheets(1).Rows.Count With Application.FileSearch .NewSearch .LookIn = ThisWorkbook.Path .SearchSubFolders = True .FileType = msoFileTypeExcelWorkbooks If .Execute() > 0 Then For i = 1 To .FoundFiles.Count If .FoundFiles(i) <> ThisWorkbook.FullName Then Set wb = Workbooks.Open(.FoundFiles(i), UpdateLinks:=0) Application.ScreenUpdating = False ThisWorkbook.Worksheets(1).Range("A" & myRow).End(xlUp).Offset(1, 0).Value = _ wb.Worksheets("○○").Range("F6").Value ThisWorkbook.Worksheets(1).Range("B" & myRow).End(xlUp).Offset(1, 0).Value = _ wb.Worksheets("○○").Range("F7").Value ThisWorkbook.Worksheets(1).Range("C" & myRow).End(xlUp).Offset(1, 0).Value = _ wb.Worksheets("○○").Range("F8").Value ThisWorkbook.Worksheets(1).Range("D" & myRow).End(xlUp).Offset(1, 0).Value = _ wb.Worksheets("○○").Range("Y6").Value wb.Close False End If Next i Else MsgBox "ファイルがありません。" End If End With End Sub