- 締切済み
VBAで別ブックからの貼付
XP、EXCEL2007を使用しています。 元ファイル（A）からVBAで他のブック（B）を開き、A～CK列データをコピー後 ファイル（A）のA～CK列に貼り付けるコードを作りました。 しかし下記の★がついている2行がエラーでうまくいきません。 改善するにはどうすれば良いかご教授下さい。 色々調べながらくっつけたコードですので、 だいぶ問題があると思います。 エラーコードは 「オートーメーションエラーです。」 「致命的なエラーです。」 Sub DATEOPEN() Dim OpenFileName As Variant With CreateObject("WScript.Shell") .CurrentDirectory = "\\Landisk\disk\テスト\" End With OpenFileName = Application.GetOpenFilename("xlsファイル (*.xls),*.xls", 1, "ファイルを選択") If OpenFileName <> "False" Then If Trim(Dir(OpenFileName)) = "" Then Call MsgBox("ファイルが見つかりません", vbOKOnly, "確認") Else Workbooks.Open OpenFileName ★ActiveSheet.Range("A:CK").Copy _ ★ThisWorkbook.Worksheets("データ貼付").Range("A:CK") ActiveWorkbook.Close Range("A:CK").Select ActiveSheet.Paste ActiveWorkbook.Saved = True Application.CutCopyMode = False End If End If End Sub
- mitsunori32
- お礼率71% (10/14)
- その他MS Office製品
- 回答数1
- ありがとう数1
- みんなの回答 （1）
- 専門家の回答
みんなの回答
- queuerev2
- ベストアンサー率78% (96/122)
実験してみたところ、コードを置く場所（モジュール）によって結果が異なるようで、エラーが出る条件はあるのですが質問者様と同じエラーは再現できませんでした。 環境はWindows XP SP3, Excel 2003です。 （当方はネットワークストレージを持っていないので "\\Landisk\disk\テスト\" → "."としました。） まず標準モジュールで実行したところ、★のところではエラーが出ずに後の方の「ActiveSheet.Paste」でエラーが出ました。そこでその行はコメントアウトしました。（以降この行はコメントアウトしたままです） 次にシート「データ貼り付け」(Sheet1)移してみました。すると、シート「データ貼り付け」がアクティブな状態で実行すると正常に終了するのですが、Sheet2がアクティブだと 「実行時エラー '1004': アプリケーション定義またはオブジェクト定義のエラーです」 と出て中断モードにも入らず停止しました。このエラーは「Range("A:CK").Select」のところで出ていることがわかったので、この行もコメントアウトしたところSheet2がアクティブでも正常に動作しました。 コードをSheet2に移しても、Sheet2がアクティブでない場合に上記と同じく停止しました。 （ちなみにThisworkbookに移すと、開いたファイルからは何もコピーされずにマクロのあるブック内部でのコピーになりましたが、これはコードの変更で対応可能です。） もし質問者様がコードをシートに置いているなら、試しに標準モジュールに移してみてはいかがでしょうか。
関連するQ&A
- VBA beforeprintについて
Private Sub Workbook_BeforePrint(Cancel As Boolean) If ActiveSheet.Name = "sheet1" Then If Range("M1").Value = "" Then Cancel = True MsgBox ("名前を入力してください") Range("M1").Select Exit Sub End If ElseIf ActiveSheet.Name = "sheet2" Then If Range("A47").Value = 文字 Then Cancel = True MsgBox ("日付を入力してください") Range("A47").Select Exit Sub End If Exit Sub End If End Sub 上記は印刷をする前に実行されるコードですが、上記を実行して印刷をした後に自動で下記のVBAを実行したいのですが Sub データー取り込み() ActiveSheet.Range("B2000:Z2000").Copy ChDir "\\データーA\データーB\データーC\データーD" Workbooks.Open Filename:="\\データーA\データーB\データーC\データーD\データーシート1.xls" Sheets("顧客データー").Select If Worksheets("顧客データー").Range("B18").Value = "" Then Worksheets("顧客データー").Range("B18").PasteSpecial Paste:=xlPasteValues Else Worksheets("顧客データー").Range("B65536").End(xlUp).Offset(1, 0).PasteSpecial _ Paste:=xlPasteValues End If ActiveWorkbook.Save ActiveWindow.Close End Sub 上記のコードと下記のコードをどのように絡めたらいいのかわかりません。アドバイスお願いします。
- ベストアンサー
- オフィス系ソフト
- 【マクロ】指定したファイルを開いてマクロを実行
マクロ初心者です。よろしくお願いします。 ＜質問＞ コマンドボタンをクリックしたら、任意のエクセルファイルを指定して開き、その開いたファイル(白紙状態のファイル)にマクロを実行させる方法を探してます。 ＜作成マクロ＞ Private Sub CommandButton1_Click() Dim OpenFileName As String OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls") If OpenFileName <> "False" Then Workbooks.Open OpenFileName End If Workbooks(Dir(OpenFileName)).Activate ActiveCell.FormulaR1C1 = "テスト" Range("A1").Select Selection.Copy Range("B1").Select ActiveSheet.Paste End Sub ＜マクロ説明＞ --コマンドボタンをクリックして指定したエクセルファイルを開く-- Private Sub CommandButton1_Click() Dim OpenFileName As String OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls") If OpenFileName <> "False" Then Workbooks.Open OpenFileName End If Workbooks(Dir(OpenFileName)).Activate --開いたエクセルファイル(白紙状態)のセルA1に「テスト」を入力した後、コピーしセルB2に貼り付ける-- ActiveCell.FormulaR1C1 = "テスト" Range("A1").Select Selection.Copy Range("B1").Select ActiveSheet.Paste End Sub コマンドボタンをクリック ↓ 任意のエクセルファイルを指定して開く ↓ 開いたファイル(白紙状態のファイル)のセルA1に「テスト」と書き込み セルA1の「テスト」をコピーしセルB1に貼り付ける このマクロを実行させるにはどこを改善すれば良いでしょうか？ ご助言いただけると助かります。 よろしくお願い致します。
- 締切済み
- Visual Basic
- 【マクロ】指定したファイルを開いてマクロを実行
マクロ初心者です。よろしくお願いします。 ＜質問＞ コマンドボタンをクリックしたら、任意のエクセルファイルを指定して開き、その開いたファイル(白紙状態のファイル)にマクロを実行させる方法を探してます。 ＜作成マクロ＞ Private Sub CommandButton1_Click() Dim OpenFileName As String OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls") If OpenFileName <> "False" Then Workbooks.Open OpenFileName End If Workbooks(Dir(OpenFileName)).Activate ActiveCell.FormulaR1C1 = "テスト" Range("A1").Select Selection.Copy Range("B1").Select ActiveSheet.Paste End Sub ＜マクロ説明＞ --コマンドボタンをクリックして指定したエクセルファイルを開く-- Private Sub CommandButton1_Click() Dim OpenFileName As String OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls") If OpenFileName <> "False" Then Workbooks.Open OpenFileName End If Workbooks(Dir(OpenFileName)).Activate --開いたエクセルファイル(白紙状態)のセルA1に「テスト」を入力した後、コピーしセルB2に貼り付ける-- ActiveCell.FormulaR1C1 = "テスト" Range("A1").Select Selection.Copy Range("B1").Select ActiveSheet.Paste End Sub コマンドボタンをクリック ↓ 任意のエクセルファイルを指定して開く ↓ 開いたファイル(白紙状態のファイル)のセルA1に「テスト」と書き込み セルA1の「テスト」をコピーしセルB1に貼り付ける このマクロを実行させるにはどこを改善すれば良いでしょうか？ ご助言いただけると助かります。 よろしくお願い致します。
- ベストアンサー
- その他MS Office製品
- 印刷後のVBAの実行 (2)
Private Sub Workbook_BeforePrint(Cancel As Boolean) If ActiveSheet.Name = "Sheet1" Then If Range("D6").Value = "" Then Cancel = True MsgBox ("名前を入力してください") Range("D6").Select Exit Sub End If Else If ActiveSheet.Name = "Sheet2" Then If Range("C11").Value = "" Then Cancel = True MsgBox ("受付時間を入力してください") Range("C11").Select Exit Sub End If Else Exit Sub End If End If ActiveSheet.Range("A70:Y70").Copy If Worksheets("Sheet3").Range("A1").Value = "" Then Worksheets("Sheet3").Range("A1").PasteSpecial Paste:=xlPasteValues Else Worksheets("Sheet3").Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial _ Paste:=xlPasteValues End If Application.CutCopyMode = False ActiveSheet.Range("A1").Select End Sub 先日、上記のコードを回答者の方から教えてもらい、とても助かっていますが sheet1のD5に「不要」という文字が入っていた場合、 sheet3への貼り付け(23～30行目の作業)をキャンセルして、最後にsheet1のA1を選択するようにはどの様にしたらいいでしょうか?
- 締切済み
- オフィス系ソフト
- （VBA）特定のシートのみを名前を付けて保存
Excel2003です。 数シートあるうちの特定のシートのみを別のbookとして「名前を付けて保存」する下記のコードを書きました。一応うまく動くのですが、実はこの特定のシートには行の非表示部分があります。しかし、下記のコードではもちろん非表示部分も開かれた状態で保存がされますよね。 この非表示の状態で保存するにはどのようにすればよいのでしょうか？ 【以下現在のコードです】 ------------------------------------------------ Sub 名前を付けて保存() '報告書を"名前を付けて保存" Sheets("報告書").Select Dim 既定ファイル名 As String Dim 保存ファイル名 As Variant 既定ファイル名 = "報告書" 保存ファイル名 = Application.GetSaveAsFilename(既定ファイル名, "Excel ブック(*.xls),*.xls") If 保存ファイル名 = False Then MsgBox "保存は中止されました。" Else With ThisWorkbook.ActiveSheet Workbooks.Add .Cells.Copy ActiveSheet.Range("A1") ActiveWorkbook.SaveAs 保存ファイル名, xlNormal ActiveWorkbook.Close False End With Sheets("報告書").Select Range("A1").Select MsgBox "報告書を作成しました。" End If End Sub ----------------------------------------------------
- ベストアンサー
- オフィス系ソフト
- 印刷後のVBAの実行 (3)
Private Sub Workbook_BeforePrint(Cancel As Boolean) If ActiveSheet.Name = "Sheet1" Then If Range("D6").Value = "" Then Cancel = True MsgBox ("名前を入力してください") Range("D6").Select Exit Sub End If Else If ActiveSheet.Name = "Sheet2" Then If Range("C11").Value = "" Then Cancel = True MsgBox ("受付時間を入力してください") Range("C11").Select Exit Sub End If Else Exit Sub End If End If If Worksheets("Sheet1").Range("D5") = "不要" Then GoTo P1 ActiveSheet.Range("A70:Y70").Copy If Worksheets("Sheet3").Range("A1").Value = "" Then Worksheets("Sheet3").Range("A1").PasteSpecial Paste:=xlPasteValues Else Worksheets("Sheet3").Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial _ Paste:=xlPasteValues End If Application.CutCopyMode = False P1: ActiveSheet.Range("A1").Select End Sub sheet1のD5に「不要」と入っていたら 24～33行目の作業がキャンセルになりますが sheet2のD5にも「不要」と入っていたら、同じ様にキャンセルできる様に出来ますでしょうか？ ご回答お願いします
- 締切済み
- オフィス系ソフト
- エクセルＶＢＡで住所録を作成
住所録シートに次のようにコードを作っています。 Option Explicit Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Address = "$B$1" Then 顧客名検索 ElseIf Target.Address = "$C$1" Then フリガナ検索 ElseIf Target.Address = "$D$1" Then 住所検索 ElseIf Target.Address = "$E$1" Then 郵便番号検索 ElseIf Target.Address = "$A$1" Then オートフィルタ解除 カナ順に設定 Else Exit Sub End If End Sub そして標準モジュールには Sub 顧客名検索() ans = InputBox("顧客名を入力してください") With ActiveSheet If .AutoFilterMode Then 'オートフィルタモードがオンなら .AutoFilterMode = False 'リセットする End If .Range("A1:G1").AutoFilter 'オートフィルタモードをセット .Range("A1:G1").AutoFilter Field:=2, Criteria1:="=*" & ans & "*" '2つ目のフィルターに検索文字 End With End Sub Sub フリガナ検索() ans = InputBox("顧客カナを入力してください") With ActiveSheet If .AutoFilterMode Then 'オートフィルタモードがオンなら .AutoFilterMode = False 'リセットする End If .Range("A1:G1").AutoFilter 'オートフィルタモードをセット .Range("A1:G1").AutoFilter Field:=3, Criteria1:="=*" & ans & "*" '3つ目のフィルターに検索文字 End With End Sub Sub 住所検索() ans = InputBox("住所を入力してください") With ActiveSheet If .AutoFilterMode Then 'オートフィルタモードがオンなら .AutoFilterMode = False 'リセットする End If .Range("A1:G1").AutoFilter 'オートフィルタモードをセット .Range("A1:G1").AutoFilter Field:=4, Criteria1:="=*" & ans & "*" '4つ目のフィルターに検索文字 End With End Sub Sub 郵便番号検索() ans = InputBox("郵便番号を入力してください") With ActiveSheet If .AutoFilterMode Then 'オートフィルタモードがオンなら .AutoFilterMode = False 'リセットする End If .Range("A1:G1").AutoFilter 'オートフィルタモードをセット .Range("A1:G1").AutoFilter Field:=5, Criteria1:="=*" & ans & "*" '5つ目のフィルターに検索文字 End With End Sub Sub オートフィルタ解除() Application.CutCopyMode = False Selection.AutoFilter Range("A1").Select End Sub Sub カナ順に設定() Range("C1").Select ActiveWorkbook.Worksheets("住所録").Sort.SortFields.Clear ActiveWorkbook.Worksheets("住所録").Sort.SortFields.Add Key:=Range("C1"), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With ActiveWorkbook.Worksheets("住所録").Sort .SetRange Range("A2:IV65536") .Header = xlNo .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Range("A2").Select Selection.AutoFilter End Sub と入れています。 VISTAで作ったのですが、このファイルを共有にして使おうとすると、XPのパソコンでは、A1セルをダブルクリックすると、コードが黄色になり、マクロが中断されます。 B1～G1は問題なくマクロが実行されるのに・・・。 もう一台のVISTAでは同じ共有状態で使っても問題ありません。 どうすればXPでも問題なく使えるのでしょう?
- ベストアンサー
- オフィス系ソフト
- エクセルVBA ブック間のコピー
選択したテキストファイルをエクセルで開いたコピーし、 もう一つ開いたエクセルファイルにペーストするというマクロをVBAで 作成していますが、つまずいてしまいました。 ----------------------------------- Dim wb1 As String Dim wb2 As String Sub Opentxt() wb1 = Application.GetOpenFilename("テキストファイル,*.txt") If wb1 <> "False" Then Workbooks.OpenText Filename:=wb1, DataType:=xlDelimited, comma:=True End If End Sub Sub Copy() Dim LastRow As Long wb2 = Application.GetOpenFilename("Microsoft Excelブック,*.xls?") If wb2 <> "False" Then Workbooks.Open wb2 LastRow = wb2.Sheets("一覧表").Range("A" & Rows.Count). End(xlUp).Row wb2.Sheets("一覧表").Range("A5:A" & lastRow).Copy _ wb1.Sheets("Sheet1).Range("B33") End If End Sub ----------------------------------- Opentxtの方は問題ないですが、Copyの方を実行すると wb1とwb2で引っかかって「コンパイルエラー/ 修飾子が不正です」と 表示されて、エラーになってしまいます。 この場合変数の型などがおかしいのでしょうか？ excel2007を使用しています。 よろしくお願いします。
- ベストアンサー
- Visual Basic
- EXCEL VBA複数ブックからの貼り付け
複数のブックにあるデータを一つのシートに繋げるマクロを作っています。 元となるブックのフォーマットは全て一緒の為下記の様なコードを書きました。 Dim OpenFileName As Variant, tmp As String, i As Long '複数のブック巣を選択 OpenFileName = Application.GetOpenFilename(FileFilter:="Microsoft Excelブック,*.xls", _ MultiSelect:=True) '名前の取得 If IsArray(OpenFileName) Then For i = 1 To UBound(OpenFileName) tmp = tmp & OpenFileName(i) & vbCrLf Next i MsgBox "選択したファイルは " & vbCrLf & tmp & " ", vbInformation Else MsgBox "キャンセルされました。", vbInformation End If '選択したブックを開く For i = 1 To UBound(OpenFileName) Workbooks.Open OpenFileName(i) Next i '最初のファイルをコピーをし、DataSheetに貼り付ける Workbooks(OpenFileName(1)).Worksheets("元帳").Cells.Copy _ Destination:=Workbooks("在庫表BETA.xls").Worksheets("DataSheet").Range("A1") '2個以降のファイルを下に貼り付ける For i = 2 To UBound(OpenFileName) Workbooks(OpenFileName(i)).Worksheets("元帳").Range("A9:V54").Copy _ Destination:=Workbooks("在庫表BETA.xls").Worksheets("DataSheet").Range("A65536").End(xlUp) Next i '最初のファイルをコピーをし、DataSheetに貼り付ける Workbooks(OpenFileName(1)).Worksheets("元帳").Cells.Copy _ Destination:=Workbooks("在庫表BETA.xls").Worksheets("DataSheet").Range("A1") 上の部分で『インデックスが有効範囲にありません。(Error 9)』の エラーが発生してしまい、困っております。 また、該当箇所をコメントアウトしても『2個目以降のファイルを貼り付ける』の箇所でも同様のエラーが発生してしまいます。 無知な私ですが、宜しくお願い致します。
- ベストアンサー
- オフィス系ソフト
- ＶＢＡでブックの集計の仕方を教えてください。
Ｈ22.12月度と言う名前のフォルダーにＡ店～Ｅ店と集計と言う名前のブックがあります。 集計のブックでＡ店～Ｅ店の集計をしてくるマクロを組んでいますが上手く作動しません。 集計のブックには、セルの書式設定をしていますので、Ａ店～Ｅ店の売上一覧のシートから 値だけをコピーして集計したいのですが、罫線やパターン、数式までコピーしてきたり、 最後のＥ店だけ２重にコピーしてきたりと変な動作をします。 初心者で本やネットで調べながら作ったので、どこの記述がおかしくて、そうなるのかがさっぱりわかりません。 どなたか教えていただけませんでしょうか。よろしくお願いします。 Sub 集計() Workbooks.Open Filename:="C:\Documents and Settings\デスクトップ\H22.12月度\Ａ店.xls" Sheets("売上一覧").Select Range("E5:Q24").Select Selection.Copy Application.WindowState = xlMinimized Windows("集計.xls").Activate Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False If Range("E5").Value <> "" Then Range("E65536").Select Selection.End(xlUp).Select Selection.Offset(1, 0).Select End If ActiveSheet.Paste Windows("Ａ店.xls").Activate Range("E5").Select Application.CutCopyMode = False ActiveWindow.Close ・ ・ ・（Ｂ・Ｃ・Ｄ店も同じ記述) ・ ・ Workbooks.Open Filename:="C:\Documents and Settings\デスクトップ\H22.12月度\Ｅ店.xls" Sheets("売上一覧").Select Range("E5:Q24").Select Selection.Copy Application.WindowState = xlMinimized Windows("集計.xls").Activate Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False If Range("E5").Value <> "" Then Range("E65536").Select Selection.End(xlUp).Select Selection.Offset(1, 0).Select End If ActiveSheet.Paste Windows("Ｅ店.xls").Activate Range("E5").Select Application.CutCopyMode = False ActiveWindow.Close Windows("集計.xls").Activate Application.WindowState = xlMaximized Range("E5").Select End Sub
- ベストアンサー
- Visual Basic
お礼
早々にご回答頂きありがとうございます。 コード自体は、標準モジュールに記載しているのですが、 思った様に希望のシートがアクティブになってくれないみたいです。 もう少し調べてみようと思います。