Excel2003のＶＢＡでデータを入力できない問題について

前へ 次へ
このQ&Aのポイント
  • Excel2003のＶＢＡでデータを入力する際に、指定したシート上にデータをペーストできない問題が発生しています。
  • 具体的には、`Range("A" & z + 1).PasteSpecial Paste:=xlPasteValues`というコードが実行時エラー1004となり、データがペーストされない状況です。
  • 問題の解決策について、アドバイスをお願いします。
回答を見る
  • ベストアンサー

Excel2003のＶＢＡで教えてください

以下のようなコードのプログラムを書いています。 使用しているシートは、"data"と"入力"という２つのシートです。 "入力"シート上で入力したデータを"data"シート上に追加していく予定です。 しかし、どうしても、"入力"シート上にペーストされてしまい"data"シート上にペーストすることができません。 Range("A" & z + 1).PasteSpecial Paste:=xlPasteValues が問題だとおもうのですが、これを Range("data!A" & z + 1).PasteSpecial Paste:=xlPasteValues と変更すると、実行時エラー1004になってしまいます。 アドバイスお願いします Private Sub CommandButton1_Click() Dim n As Integer Dim z As Long n = WorksheetFunction.CountA(Range("b9:b23")) Range("b51:f" & 51 + n - 1).Copy Set data = Worksheets("data").Range("A1") z = data.Rows.Count Sheets("data").Select Range("A" & z + 1).PasteSpecial Paste:=xlPasteValues MsgBox "登録しました" End Sub

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

  • ベストアンサー
  • BLUEPIXY
  • ベストアンサー率50% (3003/5914)
回答No.1

おそらく、「入力」シートオブジェクト上にコードを記述されているのだと思います。 コードをThisWorkbook に移せば機能すると思います

tarabooo
質問者

補足

ありがとうございます。 初心者なものですから、ついでに教えて頂きたいのですが、コードの移しかたはどうしたらよいのでしょうか？

その他の回答 (1)

  • BLUEPIXY
  • ベストアンサー率50% (3003/5914)
回答No.2

#1>コードの移しかたはどうしたらよいのでしょうか？ 状況がわからないので、的をはずしているかもしれませんが、 範囲を選択して CTRL+X して、 ThisWorkbook をダブルクリックして CTRL+V すればいいかと思います。 ボタンクリックのイベントが移せないとかそういうことなら、 標準モジュールに移して、関数名を適当に変更して、 ボタンクリックから呼び出すようにします。

tarabooo
質問者

補足

ありがとうございました。 できました！

  1. カテゴリ
  2. [技術者向] コンピューター
  3. プログラミング・開発
  4. その他（プログラミング・開発）

関連するQ&A

  • Excelの三つのVBAを一つにまとめる。

    　初めまして、よろしくお願いします。当方全くの素人でVBAの基礎もよくわからず、ネットから拾ってきていじった三つのVBAがあります。この三つ、一つ一つは個別に機能するのですが、VBAとして正しいのかさえよく解っていません。この三つを一つにまとめて、同時に機能するようにしたいと頭を抱えています。 Sub TEST() Application.ScreenUpdating = False Application.EnableEvents = False ActiveSheet.Calculate Range("b10:b20").Insert shift:=xlShiftToRight Range("b10:b20").Value = Range("a10:a20").Value Application.OnTime TimeValue("09:00:00"), "TEST" Application.ScreenUpdating = True Application.EnableEvents = True ActiveWorkbook.Save End Sub ________________________________________________________________ Sub TEST1() Application.ScreenUpdating = False Application.EnableEvents = False ActiveSheet.Calculate Dim myCnt As Long Range("c30:c40").Copy Range("d30:d40").PasteSpecial Paste:=xlPasteValues Range("b30:b40").Copy Range("c30:c40").PasteSpecial Paste:=xlPasteValues Range("a30:a40").Copy Range("b30:b40").PasteSpecial Paste:=xlPasteValues nextTime = Now() + TimeValue("01:00:00") Application.OnTime nextTime, "TEST1" Application.ScreenUpdating = True Application.EnableEvents = True ActiveSheet.Calculate ActiveWorkbook.Save End Sub ________________________________________________________________ Sub TEST2() Application.ScreenUpdating = False Application.EnableEvents = False ActiveSheet.Calculate Dim myCnt As Long Range("c50:c60").Copy Range("d50:d60").PasteSpecial Paste:=xlPasteValues Range("b50:b60").Copy Range("c50:c60").PasteSpecial Paste:=xlPasteValues Range("a50:a60").Copy Range("b50:b60").PasteSpecial Paste:=xlPasteValues nextTime = Now() + TimeValue("00:10:00") Application.OnTime nextTime, "TEST2" Application.ScreenUpdating = True Application.EnableEvents = True ActiveSheet.Calculate ActiveWorkbook.Save End Sub ________________________________________________________________ 　解る方、よろしくお願いします。

  • 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 上記のコードと下記のコードをどのように絡めたらいいのかわかりません。アドバイスお願いします。

  • このVBAの処理を速くしたいのですが…

    お世話になります data.xlsmとBook1-Book25.xlsxの 合計26ファイルを開いた状態で 以下のマクロを実行しています 私が使っているマシンでは 10分くらいかかるのですが この時間を短くすることは 出来ますでしょうか？ Sub copy() Application.ScreenUpdating = False Workbooks("Book1.xlsx").Worksheets("Sheet1").Range("A1:D1048576").copy Workbooks("data.xlsm").Worksheets("Sheet1").Range("A1").PasteSpecial Paste:=xlPasteValues Range("G1:K1048576").Clear Range("A1:E1048576").copy Range("G1:K1048576").PasteSpecial Paste:=xlPasteValues Range("I2").ClearContents Range("I1048576").End(xlUp).ClearContents Range("A2:D1048576").Clear Range("O1:Q1").copy Range("S1048576").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues あとは上記をBook2,Book3と変えてBook25まで同じ式を記入 End Sub

  • Excel2007　VBA　転記について

    ご指導のほどお願いします。 見積書からボタン300をクリックするとＦＡＸ送付状（テンプレート）.xlsに下記内容が転記するように書いたのですが、質問させてください。 ("見積書").Range("c6")→("Sheet1").Range("e14")に貼り付けはうまく行きますが 本当は("見積書").Range("c6")＆("見積書").Range("c8")=&"の件"を("Sheet1").Range("e14")に貼り付けしたいのです。 C6セル「○○○工場」 C8セル「○○○作業」 の件 ↑をE14セルに「○○○工場　○○○作業の件」 として貼り付けたいです。 Sub ボタン300_Click() Workbooks.Open "\FAX送付状\ＦＡＸ送付状（テンプレート）.xls" ThisWorkbook.Worksheets("見積書").Range("a4").Copy Workbooks("ＦＡＸ送付状（テンプレート）.xls").Worksheets("Sheet1").Range("f6").PasteSpecial Paste:=xlPasteValues ThisWorkbook.Worksheets("見積書").Range("i8").Copy Workbooks("ＦＡＸ送付状（テンプレート）.xls").Worksheets("Sheet1").Range("AD9").PasteSpecial Paste:=xlPasteValues ThisWorkbook.Worksheets("見積書").Range("c6").Copy Workbooks("ＦＡＸ送付状（テンプレート）.xls").Worksheets("Sheet1").Range("e14").PasteSpecial Paste:=xlPasteValues　 ActiveSheet.Range("F9").Value = Date End Sub ご指導のほどお願いします。

  • エクセルVBAで教えて下さい。

    エクセルVBAで以下の方法のマクロが分からず、教えて頂きたいです。 まず、ブックAのシートAがあり、シートAのセルD3には号機No.を入力します（999などの数値のみ） 次にブックBのシートBがあり、このシートのD列にも号機No.が入力されています。 やりたい事はブックAのシートAのD3に号機No.を入力したら、ブックBのシートBのD列から同じ号機No.を 探し、当てはまる号機の行のI列、J列、K列、L列、M列をコピーし ブックAのシートAのF13、F14、F15、F16、F17、に貼り付けたいです。 それぞれの貼り付け先は K列⇒F13　L列⇒F14　M列⇒F15　I列⇒F16　J列⇒F17のようになります。 それとブックBのシートBのD列に入力されている号機No.は同じ数値が入力されている時があります。 この場合は必ず下にある号機No.のが最新ですので、そちらを読み取るようにしたいです。 例えば、4行目と8行目に同じ号機No.がある場合は8行目の方を読み取る。 現在は　GYOU = Application.InputBox　でターゲットの行番号を入力して その行の列をコピー・ペーストしている感じです。 Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next Dim tmp() As String If Intersect(Target, Range("D3")) Is Nothing Then Exit Sub Else End If Dim buf As String Dim j As Integer Dim GYOU As String Set xCur = Selection Dim OpenFileName As String Workbooks.Open Filename:="業務都合の為載せれません" GYOU = Application.InputBox("行を選択してください", "行指定") '<キャンセルの場合、処理を終わりにします。> If GYOU = "False" Then Exit Sub For j = 11 To 11 ActiveSheet.Cells(GYOU, j).Copy ThisWorkbook.ActiveSheet.Cells(13, 6).PasteSpecial Paste:=xlPasteValues Next j For j = 12 To 12 ActiveSheet.Cells(GYOU, j).Copy ThisWorkbook.ActiveSheet.Cells(14, 6).PasteSpecial Paste:=xlPasteValues Next j For j = 13 To 13 ActiveSheet.Cells(GYOU, j).Copy ThisWorkbook.ActiveSheet.Cells(15, 6).PasteSpecial Paste:=xlPasteValues Next j For j = 9 To 9 ActiveSheet.Cells(GYOU, j).Copy ThisWorkbook.ActiveSheet.Cells(16, 6).PasteSpecial Paste:=xlPasteValues Next j For j = 10 To 10 ActiveSheet.Cells(GYOU, j).Copy ThisWorkbook.ActiveSheet.Cells(17, 6).PasteSpecial Paste:=xlPasteValues Next j ActiveWorkbook.Close SaveChanges:=False With xCur .Parent.Parent.Activate '元のブックへもどる .Parent.Activate '元のシートへもどる End With End Sub ど素人の為、めちゃくちゃな並びだとは思いますが一応現在の状態のマクロを載せておきます。 御指導の程、宜しくお願いします。

  • エクセルのVBAで教えて下さい。

    エクセルVBAで以下の方法のマクロが分からず、教えて頂きたいです。 まず、ブックAのシートAがあり、シートAのセルD3には号機No.を入力します（999などの数値のみ） 次にブックBのシートBがあり、このシートのD列にも号機No.が入力されています。 やりたい事はブックAのシートAのD3に号機No.を入力したら、ブックBのシートBのD列から同じ号機No.を 探し、当てはまる号機の行のI列、J列、K列、L列、M列をコピーし ブックAのシートAのF13、F14、F15、F16、F17、に貼り付けたいです。 それぞれの貼り付け先は K列⇒F13　L列⇒F14　M列⇒F15　I列⇒F16　J列⇒F17のようになります。 それとブックBのシートBのD列に入力されている号機No.は同じ数値が入力されている時があります。 この場合は必ず下にある号機No.のが最新ですので、そちらを読み取るようにしたいです。 例えば、4行目と8行目に同じ号機No.がある場合は8行目の方を読み取る。 現在は　GYOU = Application.InputBox　でターゲットの行番号を入力して その行の列をコピー・ペーストしている感じです。 Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next Dim tmp() As String If Intersect(Target, Range("D3")) Is Nothing Then Exit Sub Else End If Dim buf As String Dim j As Integer Dim GYOU As String Set xCur = Selection Dim OpenFileName As String Workbooks.Open Filename:="業務都合の為載せれません" GYOU = Application.InputBox("行を選択してください", "行指定") '<キャンセルの場合、処理を終わりにします。> If GYOU = "False" Then Exit Sub For j = 11 To 11 ActiveSheet.Cells(GYOU, j).Copy ThisWorkbook.ActiveSheet.Cells(13, 6).PasteSpecial Paste:=xlPasteValues Next j For j = 12 To 12 ActiveSheet.Cells(GYOU, j).Copy ThisWorkbook.ActiveSheet.Cells(14, 6).PasteSpecial Paste:=xlPasteValues Next j For j = 13 To 13 ActiveSheet.Cells(GYOU, j).Copy ThisWorkbook.ActiveSheet.Cells(15, 6).PasteSpecial Paste:=xlPasteValues Next j For j = 9 To 9 ActiveSheet.Cells(GYOU, j).Copy ThisWorkbook.ActiveSheet.Cells(16, 6).PasteSpecial Paste:=xlPasteValues Next j For j = 10 To 10 ActiveSheet.Cells(GYOU, j).Copy ThisWorkbook.ActiveSheet.Cells(17, 6).PasteSpecial Paste:=xlPasteValues Next j ActiveWorkbook.Close SaveChanges:=False With xCur .Parent.Parent.Activate '元のブックへもどる .Parent.Activate '元のシートへもどる End With End Sub ど素人の為、めちゃくちゃな並びだとは思いますが一応現在の状態のマクロを載せておきます。 御指導の程、宜しくお願いします。

  • ＶＢＡのコピー

    ＶＢＡのコピー Dim xls As New Excel.Application Dim wbk As New Excel.Workbook Dim sh3 As Worksheet Set sh3 = Worksheets("全") sh3.Activate sh3.Range("A1:Z65536").Select Selection.Clear Set wbk = xls.Workbooks.Open("\\***.***.*.***\管理\全データ抽出.xls") wbk.Worksheets("全").Activate 'ワークシートをアクティブにする wbk.Worksheets("全").Range("A1:Z65536").Copy 'コピーする 'ActiveSheet.Paste Destination:=Worksheets("全").Range("A1") '貼り付ける Worksheets("全").Range("A1").PasteSpecial Paste:=xlPasteValues wbk.Close SaveChanges:=False 'Worksheets("メイン").Cells(1, 1).Select を実行すると　『wbk.Close SaveChanges:=False』のところで クリップボードに大きな情報があります。・・・・ と言うメッセージがでて必ずとまってしまうのですが メッセージをでないようにしたいのですが 教えてください。お願いします。

  • VBA空白を除いてコピーが出来ません。ご指導お願いします。

    値のコピー＆ペースト（空白を除いてコピー）したいと思っております。 シート１　の　A35、D35、I35　をコピー。 シート２　の　A2　に貼り付け。 これは、大丈夫です。 シート１　の　M2　：　O23　をコピー。 シート２　の　E2　に貼り付け。 今回の場合ですと、M2　：　O13　までに値が入ってます。 ですので、M14　：　O23　までが、空白になって記入となってしまいます。 ＊毎回、値が入る量が違います。 一回のコピーですと、これでもいいのですが、 値を変更して、コピーを続けてしますので、M14　：　O23　までが、空白になってM24からのコピーになってしまいます。 空白を除いて、貼り付けしたいのですが、 どうすればいいのかわかりません。 お分かりになる方、ご指導よろしくお願いします。 VBAは以下になっております。 Sub Macro1() ' Application.ScreenUpdating = False Sheets("Sheet1").Range("A35,D35,I35").Copy If Sheets("Sheet2").Range("A2").Value = "" Then Sheets("Sheet2").Range("A2").PasteSpecial Paste:=xlPasteValues Else Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues End If Sheets("Sheet1").Range("M2:O23").Copy If Sheets("Sheet2").Range("E2").Value = "" Then Sheets("Sheet2").Range("E2").PasteSpecial Paste:=xlPasteValues Else Sheets("Sheet2").Range("E" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues End If Application.CutCopyMode = False Application.ScreenUpdating = True End Sub よろしくお願いします。

  • VBAの実行時エラー91！どうしよう？

    excelＶＢＡでファイル内の各シートを確認して、条件に合うシートのデータをコピーするところで、「実行時エラー'91'オブジェクト変数またはWithブロック変数が設定されていません。」というエラーが出ました。 確認したのですが、なかなか分かりません。どなたがご指導お願いできませんか。 コードは以下のとおりです。 Sub Tenki(theBook As Workbook, mySheet As Worksheet) Dim K_Sheet As Worksheet Dim DstRange As Range For Each K_Sheet In theBook.Worksheets　　’ここで、エラーが出ました！ If K_Sheet.Name <> "C" Then Set DstRange = mySheet.Range("A" & _ mySheet.Range("A1").CurrentRegion.Rows.Count + 1) K_Sheet.Range("B7:K48").SpecialCells(xlCellTypeVisible).Select Range("B7:K48").Copy DstRange.PasteSpecial Paste:=xlPasteValues End If Next Application.CutCopyMode = False 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にも「不要」と入っていたら、同じ様にキャンセルできる様に出来ますでしょうか？ ご回答お願いします

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する