- ベストアンサー
Excel2003でworksheetクラスのCopyメソッドが失敗しました
- Excel2003でworksheetクラスのCopyメソッドが失敗し、原因がわからず困っています
- コードの中で複数回Copyメソッドを使っているが、一部の箇所でエラーが発生します
- Copyメソッドの引数を省略すると成功するため、何か問題のある箇所があると考えられます
- anman0201
- お礼率42% (85/200)
- Visual Basic
- 回答数2
- ありがとう数9
- みんなの回答 （2）
- 専門家の回答
質問者が選んだベストアンサー
その他の回答 (1)
- kmetu
- ベストアンサー率41% (562/1346)
関連するQ&A
- 【VBA】 Copyメソッドの使用方法について
【動作環境】 Excel 2003 【仕様概要】 EXCEL起動時に共有フォルダ内のEXCELシートよりマスタ情報を取得し、クライアント側のマスタ情報を最新情報に更新させたい。 【質問内容】 下記コードを実行すると12行目のCopyメソッドを発行時に下記メッセージが表示されてしまいます。 初歩的なコーディング誤りと思われますが、ご教授お願い申し上げます。 [実行時エラー'1004' 'Copyメソッドは失敗しました: '_Worksheet'オブジェクト] ========================================================================= 01: Sub auto_open() 02: Dim xlApp As Excel.Application '/* EXCELオブジェクト変数宣言 - Application */ 03: Dim xlBook As Excel.Workbook '/* EXCELオブジェクト変数宣言 - Workbook */ 04: Dim xlSheet As Excel.Worksheet '/* EXCELオブジェクト変数宣言 - Worksheet */ 05: 06: ' /* EXCELファイルオープン */ 07: Set xlApp = CreateObject("Excel.Application") 08: Set xlBook = xlApp.Workbooks.Open("共有ドライブ\マスタ情報.xls") 09: Set xlSheet = xlBook.Worksheets("マスタ情報") 10: 11: ' /* マスタ情報取得(ワークシートコピー) */ 12: xlSheet.Copy after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count) 13: 14: ' /* EXCELアプリケーション終了 */ 15: xlBook.Close 16: xlApp.Quit 17: 18: ' /* EXCELオブジェクト変数解放 */ 19: Set xlSheet = Nothing 20: Set xlBook = Nothing 21: Set xlApp = Nothing 22: End Sub =========================================================================
- ベストアンサー
- Visual Basic
- EXCEL2000とEXCEL2003のVBAについて
現在、EXCEL2000で下記のコードを実行しています。 が、EXCEL2003で実行すると、 .UsedRange.Copy myb のコードが実行されているのにコピー出来ていません。 ファイルは開いていて、エラーは出ていないのです。 問題点わかる方教えていただけますか？ Sub 日別データ読込() Dim rngsaki As Range Dim pathmacrobook As String Dim namebook As String Dim motobook As Workbook Dim myb As Variant Set rngsaki = Workbooks("残高集計用.xls").Worksheets(3).Range("a2") pathmacrobook = ThisWorkbook.Path & "\CSV読込データ12\" namebook = Dir(pathmacrobook & "*.xls") Do While Not namebook = "" Set motobook = Workbooks.Open(pathmacrobook & namebook) Set myb = Workbooks("残高集計用.xls").Worksheets(3).Range("A65536").End(xlUp) With motobook.Worksheets("Sheet1") .UsedRange.Copy myb End With motobook.Close False namebook = Dir() Loop MsgBox "完了しました" End Sub
- ベストアンサー
- オフィス系ソフト
- 最終シートからその手前まで５シートの選択したい
最終シート名が「基本」、その前が「種別」、さらにその前が「一覧」と言うシート名になっています。 またその「一覧」の前２ケは、シート名をindexで指定したいです。 以下のコードを実行してもうまく、シートを除外してくれません。どうしたらよろしいでしょうか。 Sub 各シートに関数を入力() Dim EXCEPT_NAME As String EXCEPT_NAME = " 一覧 種別 基本" & Worksheets(Sheets.Count - 4).name & Worksheets(Sheets.Count - 5).name Application.ScreenUpdating = False ChDrive ThisWorkbook.Path ChDir ThisWorkbook.Path Dim list, sheetName For Each sheetName In ActiveWorkbook.Worksheets If InStr(EXCEPT_NAME, sheetName.name) = 0 Then Sheets(sheetName.name).Activate ActiveSheet.Unprotect Call 関数貼付 End If Next End Sub
- ベストアンサー
- Visual Basic
- PasteSpecialメソッドの失敗
会社でVBAの勉強をしているのですが、 自分でコードを書いてみたところエラーが出て困っております 初心者なのでエラーの意味もわからずここにきました みなさまよろしくお願いします(・・;) Sub nigate() Const SH_NAME As String = "おはようございます" Dim i Dim ws As Worksheet Dim writerow As Integer Dim endrow As Long Set ws = ThisWorkbook.Worksheets(SH_NAME) writerow = 2 With ws endrow = .Cells(Rows.Count, 2).End(xlUp).Row .Columns("M:N").Clear For i = 2 To endrow If Range("D" & i).Font.ColorIndex = 3 Then Range("C" & i).Copy Range("L" & writerow) .PasteSpecial xlPasteAllExceptBorders writerow = writerow + 1 Application.CutCopyMode = False ElseIf Range("D" & i).Interior.ColorIndex = 36 Then Range("C" & i).Copy Range("K" & writerow) .PasteSpecial xlPasteAllExceptBorders writerow = writerow + 1 Application.CutCopyMode = False End If Next i End With End Sub これを実行すると、 PasteSpecialメソッドは失敗しました`Worksheet`オブジェクト と表示され止まってしまいます コードで言うと ．PasteSpecial ｘｌPasteAllExceptBorders のところが黄色くなります よろしくお願いしますm(__)m
- ベストアンサー
- Visual Basic
- rangeメソッドは失敗しました
またまたエラーが起きてしまいました、、 D列にある数値の平均値を出すマクロを組みたいのですが そのD列は今後増えていくので変数を使い指定したいのです Option Explicit Public Sub all() Const SH_NAME As String = "VBA" Dim i Dim endrow As Long Dim ws As Worksheet Dim Result As Integer Set ws = ThisWorkbook.Worksheets(SH_NAME) With ws endrow = .Cells(Rows.Count, 4).End(xlUp).Row For i = 2 To endrow Result = Application.WorksheetFunction.Average(.Range("D2:D&i")) .Range("F39").Value = Result .Range("F39").NumberFormatLocal = "0.00" Next i End With End Sub このコードだと Result = Application.WorksheetFunction.Average(.Range("D2:D&i")) のところでrangeメソッドは失敗しました と言われてしまいます どうかよろしくお願いします<m(__)m>
- ベストアンサー
- Visual Basic
- ＶＢＡにて新規ブックへ既存シートのコピー
みなさんのお力を貸して下さい。 現在エクセルマクロにて新規ブックを作成し、作成したブックへ既存のシートをコピーをしたいと思っています。 しかし、コピーメソッド実行時にエラー1004 WorksheetクラスのCopyメソッドが失敗しましたというエラーが発生して困っています。 Dim oXls As Object Dim oWbk As Object Dim oSheet As Object Set oXls = CreateObject("Excel.Application") Set oWbk = oXls.Workbooks.Add ThisWorkbook.Worksheets("Sheet1").Copy Before:=oWbk.Worksheets("Sheet1") どなたかご教授、よろしくお願いします。
- ベストアンサー
- Visual Basic
- ExecuteExcel4Macroでセル値取得
office2010 あるフォルダにファイルを入れて、ファイルを開かずに対象シートの対象セルの値を取得したいです。 この取得したいセル情報を、変数で指定したいのです。 C:\dataに取得元のファイルが入っています。 このファイル名((1)）は、いろいろ変わりますが、中にH4という文字があります。 対象シートのシート名とセルアドレスは、別のファイル（これにマクロがあります） のsettingシートで指定します。 １例ですが、settingシートの B2に11_001 C2にAF9 と設定します。 (1)のファイルで11_001というシートのAF9セル値を取得したいのです。 Dim myPath As String Dim myFile As String myPath = "C:\data\" myFile = Dir(myPath & "*H4*.xlsm") Dim sheetname As String Dim cell As String sheetname = Worksheets("setting").Range("B2") cell = Worksheets("setting").Range("C2").Value ' 'Range("A1") = ExecuteExcel4Macro("'[" & myFile & "]" & sheetname & "'!R9C32") Range("A1") = ExecuteExcel4Macro("'[" & myFile & "]" & sheetname & "'!" & cell & "") 上記で、 Range("A1") = ExecuteExcel4Macro("'[" & myFile & "]" & sheetname & "'!R9C32") は、値取得できます。 このR9C32を変数にする所で、エラーが発生します。 実行時エラー1004と。 いろいろWEB見て、’,スペース等を入れてみましたが、どうしても分からず、 Range("A1") = ExecuteExcel4Macro("'[" & myFile & "]" & sheetname & "'!" & cell & "") の最後のセル指定を、変数で設定する方法を教えて頂きたく。
- ベストアンサー
- Excel（エクセル）
- 複数シート、計算範囲が可変でのピボットテーブルマクロ
初めてのマクロで困っています。 エラーメッセージは、 実行時エラー '13': 型が一致しません。 ＝＝＝で囲んだ部分がデバックをクリックすると黄色で表示されます。 すみませんが、どなたかご指摘お願いします。 どうぞよろしくお願いいたします。 Sub test() Dim i As Integer Dim SET_SheetCnt As Integer Dim SET_SheetName As String Dim SET_SheetN_C As String Dim SET_startRow As Long Dim SET_endRow As Long Dim SET_startCell As String Dim SET_endCell As String Dim SET_Cell As String Dim SET_Returnsheet As String Dim DQ As String Dim SET_FileNo As Integer SET_SheetCnt = ThisWorkbook.Sheets.Count SET_Returnsheet = ActiveSheet.Name SET_FileNo = FreeFile DQ = Chr$(&H22) Sheets(SET_Returnsheet).Cells.Clear For i = 1 To SET_SheetCnt SET_SheetName = Worksheets(i).Name If SET_SheetName <> SET_Returnsheet And SET_SheetName <> "template" Then With ThisWorkbook.Worksheets(i) 'Start行 Cells(2, 2).Select SET_startRow = .Cells.Find(What:="業務名", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, MatchByte:=False).Row SET_startCell = "R" & SET_startRow & "C3" 'End行 SET_endRow = .Cells(.Rows.Count, 19).End(xlUp).Row SET_endCell = "R" & SET_endRow & "C19" SET_Cell = SET_startCell & ":" & SET_endCell '計算範囲の書き込み Worksheets(SET_Returnsheet).Cells(1, 1).Value = "計算範囲" Worksheets(SET_Returnsheet).Cells(Rows.Count, 1).End(xlUp).Offset(1).Value = "Array(" & DQ & "'" & SET_SheetName & "'!" & SET_Cell & DQ & ", " & DQ & SET_SheetName & DQ & "), " End With End If Next i '最終セルの不要な文字列を取りファイルに格納 Sheets(SET_Returnsheet).Select Dim LastRow As Integer With Worksheets(SET_Returnsheet).Cells.SpecialCells(xlCellTypeConstants).Areas With .Item(.Count) LastRow = .Item(.Count).Row End With End With Dim a As String Dim b As String Dim c As String Dim d As String a = Worksheets(SET_Returnsheet).Cells(LastRow, 1).Value b = Len(a) c = Mid(a, 1, (b - 2)) Worksheets(SET_Returnsheet).Cells(LastRow, 1).Value = c Open "c:\test.txt" For Output As #SET_FileNo For i = 2 To LastRow d = Worksheets(SET_Returnsheet).Cells(i, 1).Value Print #SET_FileNo, d; Next i Close #SET_FileNo Dim FileData As variant Open "c:\test.txt" For Input As #SET_FileNo While Not EOF(SET_FileNo) Line Input #SET_FileNo, FileData Debug.Print FileData Wend Close #SET_FileNo 'ピボット計算------- Worksheets(SET_Returnsheet).Activate Sheets(SET_Returnsheet).Cells.Clear '==ここから黄色で囲まれる分です==== ThisWorkbook.PivotCaches.Add(SourceType:=xlConsolidation, SourceData:= _ Array(FileData)).CreatePivotTable TableDestination _ :=Range("A11"), TableName:="ピボットテーブル1" '===ここまで==== ActiveSheet.PivotTables("ピボットテーブル1").SmallGrid = False ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("データ").PivotItems( _ "データの個数 : 値").Position = 1 Range("A17").Select ActiveWindow.SmallScroll Down:=-9 ActiveSheet.PivotTables("ピボットテーブル1").PivotSelect "行[すべて]", xlLabelOnly Range("A11").Select ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("データの個数 : 値").Function = _ xlSum End Sub
- ベストアンサー
- Visual Basic
- 部署ごとに分割し、ブックで保存するコード
部署ごとに分割し、ブックで保存するコードです。 A1、1列目から分割していますが、B2、4列目から分割する方法を教えてください。 A65536をB65536に変えたりなどしていましたが、エラーが出ます。 よろしくお願いします。 Sub macro1() Dim w As Worksheet Dim n As Long Dim r As Long Dim s As String Dim WSH As Variant Dim myPath As String Set w = ActiveSheet n = Worksheets.Count Application.ScreenUpdating = False On Error GoTo errhandle For r = 2 To w.Range("A65536").End(xlUp).Row s = w.Cells(r, "A") w.Rows(r).Copy Worksheets(s).Range("A65536").End(xlUp).Offset(1) Next r On Error GoTo 0 Set WSH = CreateObject("Wscript.Shell") myPath = ThisWorkbook.Path & "\" For r = Worksheets.Count To n + 1 Step -1 Worksheets(Worksheets.Count).Copy ActiveSheet.Columns.AutoFit ActiveWorkbook.SaveAs Filename:=myPath & ActiveSheet.Name ActiveWorkbook.Close False Application.DisplayAlerts = False Worksheets(Worksheets.Count).Delete Application.DisplayAlerts = True Next r w.Select Exit Sub errhandle: Worksheets.Add after:=Worksheets(Worksheets.Count) ActiveSheet.Name = s w.Rows(1).Copy Range("A1") Resume Application.ScreenUpdating = True End Sub
- ベストアンサー
- Visual Basic
- excel2007でエラーになるマクロ
Excel2003では問題なく動いていた以下のマクロですが、これはボタンにマクロを貼り付けてあり、それを2007で実行すると、「問題が発生したため、Microsoft Office Excelを終了します」となり、強制終了になってしまいます。 でも、VBEの方で実行すると、ワークシートはちゃんと保存されて正しく閉じます。 （その場合、VBE自体は終了にならず、起動したままです） また、マクロを表示させてマクロ名を選択し、実行をクリックすると、正常に動作します。 新しく別の図形を作成し、そこにマクロを貼り付けるとやはり強制終了になります。 Excel2007で、リソースの診断などしても問題は見つかりません。 Windowsは、ＳＰ２でだめだったので、ＳＰ３にしてみましたが、現象は同じで何ら変化はありませんでした。 エラーを出さなくするにはどうすればよいのでしょうか。 --------マクロ--------- Sub ファイル名を変えて保存して閉じる() Dim nnen As String Dim kcode As String Dim kcode2 As String Dim cname As String Dim dno As String Dim dno2 As String Dim myPath As String nnen = ActiveWorkbook.Worksheets("inputform").Range("O5") kcode = ActiveWorkbook.Worksheets("inputform").Range("R3") kcode2 = Format(kcode, "000") cname = ActiveWorkbook.Worksheets("inputform").Range("C7") dno = ActiveWorkbook.Worksheets("inputform").Range("H26") dno2 = Format(dno, "00000") myPath = ThisWorkbook.Path & "\" On Error Resume Next 'エラーが発生しても処理を続行する ActiveWorkbook.SaveAs Filename:=myPath & "様式5_" & nnen & kcode2 & "【" & cname & dno2 & "】" _ , CreateBackup:=False On Error GoTo 0 'エラー処理ルーチンを無効にする ActiveWorkbook.Close End Sub
- ベストアンサー
- オフィス系ソフト
