• ベストアンサー

シート間のコピーマクロについて

下記のような、TextBoxで入力した行の内容を違うシートへ貼り付けるマクロを作成しています。 マクロは素人で参考書を見ながら作製しているのですが、 「ActiveSheet.Range("A&r:Z&r").Copy Destination:=Worksheets(tuki).Range("A&idousaki:Z&idousaki")」 のところで、 『アプリケーション定義またはオブジェクト定義のエラーです』 と表示されます。 多分めちゃくちゃな文をかいてるんだろうなと思うのですが、私には分かりませんでした・・・ どなたか、修正点をご教授お願致します。 Private Sub OK_Click() Dim r As Integer, tuki As String, idousaki As Variant If OptionButton1.Value = True Then '行指定 r = TextBox1.Value tuki = ComboBox1.Value '移動先の行番号取得 If Worksheets(tuki).Range("D7").Offset(1).Value = "" Then idousaki = Worksheets(tuki).Range("D7").Offset(1).Rows Else idousaki = Worksheets(tuki).Range("D7").End(xlDown).Ofset(1).Rows End If ActiveSheet.Range("A&r:Z&r").Copy Destination:=Worksheets(tuki).Range("A&idousaki:Z&idousaki") Else MsgBox "移動方法を選択してください" End If End Sub

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

  • ベストアンサー
noname#89471
noname#89471
回答No.5

一箇所、 idousaki = Worksheets(tuki).Range("D7").End(xlDown).Ofset(1).Rows の Ofset(1) は、 Offset(1) ですね。 [結論] hallo-2007さんのご回答のとおり。 idousaki = Worksheets(tuki).Range("D7").Offset(1).Row ではないでしょうかね?(Rowsではない) ActiveSheet.Range("A" & r & ":Z" & r).Copy Destination:=Worksheets(tuki).Range("A" & idousaki) でもよいです。(Range("A" & idousaki & ":Z" & idousaki)でなくてもよい) [確認方法] idousaki = Worksheets(tuki).Range("D7").Offset(1).Rows msgbox ("idousaki = " & idousaki) と記述し、確認したら、msgboxの表示は、 idousaki = でした。 idousakiは、行番号を取得できていないようです。 ためしに、行番号抜きの ------------------- Sub test() Range("A1:Z1").Copy Destination:=Worksheets("Sheet2").Range("A:Z") End Sub ------------------- を作って、Sheet1のA1からZ1に値入れて、上記 test マクロを実行したら...A1からZ1の値をSheet2のA1からZ65536までコピーしました。 どのように使用されるのかはわかりませんが、OptionButton1、TextBox1、ComboBox1 が配置されているようですので、 UserFormを使用していると勝手に判断し... UserForm1を作って、CommandButton1、CommandButton2を追加で配置して、 CommandButton1_Clickの動作として、当方で確認したものを、 CommandButton2_Clickの動作として、質問者様のものを、 として確認してみました。 コードが必要でしたら補足してください。 しばらくファイルはとっておきます。

tatewaki_K
質問者

お礼

ご回答ありがとうございます。 すごい・・・ 記載通りで出来ました! ありがとございます。

その他の回答 (4)

  • hallo-2007
  • ベストアンサー率41% (888/2115)
回答No.4

デバックした時に マウスを r とか idousaki とかの変数の上に移動してみてください。 変数に入っている値が表示されます。希望している値が出ていますでしょうか。 idousaki = Worksheets(tuki).Range("D7").End(xlDown).Ofset(1).Rows 希望のセルの行番号を取得したいのだと思いますが 最後のOfset(1).Rowsは Ofset(1).Row では。 エラーではありませんが Destination=Worksheets(tuki).Range("A" & idousaki) と最初のセルを指定しても大丈夫かと。

  • hallo-2007
  • ベストアンサー率41% (888/2115)
回答No.3

No1です。ちょっと訂正します Range("A" & r & ":Z" & r) ("A" & idousaki & ":Z" & idousaki) &を忘れてました。

tatewaki_K
質問者

お礼

ActiveSheet.Range("A" & r & ":Z" & r).Copy Destination:=Worksheets(tuki).Range("A" & idousaki & ":Z" & idousaki) にしたら一歩進みました! しかし、次は以下エラーがでてしまいした・・・ 「選択範囲が大きすぎます」 ん~なかなかうまくいかない。

  • phoenix343
  • ベストアンサー率15% (296/1946)
回答No.2

ヒント "A&r:Z&r" これじゃただの文字列だよ。 "A" & r & ":Z" & r だろう?

  • hallo-2007
  • ベストアンサー率41% (888/2115)
回答No.1

「ActiveSheet.Range("A&r:Z&r").Copy Destination:=Worksheets(tuki).Range("A&idousaki:Z&idousaki")」 は Range("A"&r":Z"&r) と ("A"&idousaki":Z"&idousaki) ではなかろうかと

関連するQ&A

  • Bookを指定して開くマクロについて

    私は、今行の移動マクロを作成しています。 (1)対象のエクセルには1月から12月までのシートが存在する (2)移動はシート間の移動 (3)移動ボタンを押すとユーザフォームを表示 (4)ユーザフォームで移動月(シート)と移動する行を記入 (5)移動先シートの最終行にコピー このマクロを別のBookにコピー可能なようにしたいのですが、その方法が分かりません。 今考えている方法としては、 (1)ユーザフォームに「別の月」というボタンを作る (2)別の月をクリックするとファイル選択画面を出す (3)移動したいBookを選択する (4)開いたBookの名前を取得し、そのBookに移動する (2)~(4)をどうやったら良いのかさっぱり分からない状況です。 ネットで調べても、最初からBook名が分かっている場合しか出てきません。 どうかご教授お願致します。 ☆下記のようなマクロを書いてます。☆ '移動先にオートフィルターがかかっていたら外す If Worksheets(tuki).AutoFilterMode = True Then Worksheets(tuki).AutoFilterMode = False End If '移動先の行番号取得 If Worksheets(tuki).Range("B7").Offset(1).Value = "" Then idousaki = Worksheets(tuki).Range("B7").Offset(1).Row Else idousaki = Worksheets(tuki).Range("B7").End(xlDown).Offset(1).Row End If '移動行の情報取得 Dim r As Integer r = TextBox1.Value 'コピー ActiveSheet.Range("A" & r & ":AB" & r).Copy Destination:=Worksheets(tuki).Range("A" & idousaki & ":AB" & idousaki)

  • マクロについて教えてください。

    最近、勉強し始めました。 名簿を作成しています。Sheet1のデータを2種類に分けてSheet2(県外)、Sheet3(県内)のあらかじめ作成している表に振り分けたいのです。 しかしながら、1名分のデータをコピーして張り付けることはしたのマクロで出来たのですが、2名分もこのようにするとなると手入力したほうが速いような気がしています。 なにかいい方法がありましたら教えてください。 Sub コピーして別のシートに貼り付ける1() Worksheets("Sheet1").Activate Range("B11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("B10:E17") Range("C11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("A18:E19") Range("D11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("F10:K17") Range("E11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("F18:K19") Range("F11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("M10:S10") Range("G11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("M11:S11") Range("H11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("M12:S12") Range("I11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("M13:S13") Range("J11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("M14:S14") Range("K11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("M15:S15") Range("L11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("M16:S16") Range("M11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("M17:S17") Range("N11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("M18:S18") Range("O11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("M19:S19") Range("P11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("T10:T19") Range("Q11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("U10:U19") Range("R11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("V10:V19") Range("S11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("W10:W19") Range("T11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("X10:X19") Range("U11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("Y10:Y19") Range("V11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("Z10:Z19") Range("W11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("AA10:AA19") Range("X11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("AB10:AB19") Range("Y11").Copy ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range("AC10:AG19") End Sub

  • ユーザーフォームのデータ

    ユーザーファームを2つ作成しました。 そのユーザーフォームのデータを表の最終行に追加をしたいのです。 Range("A65536").End(xlUp).Offset(1,0).select を使おうと思っていますが、うまくいきません。 どなたか教えてください。 <ユーザーフォーム1> Private Sub CommandButton1_Click() Sheet2.Range("H7") = TextBox1 Sheet2.Range("I7") = TextBox2 Sheet2.Range("J7") = TextBox3 Sheet2.Range("K7") = TextBox4 Sheet2.Range("L7") = TextBox5 Sheet2.Range("P7") = TextBox6 If CheckBox1.Value = True Then Worksheets(2).Range("M7") = "0:30" Else Worksheets(2).Range("M7") = "0:00" End If If CheckBox2.Value = True Then Worksheets(2).Range("R7") = "1000" Else Worksheets(2).Range("R7") = "0" End If If CheckBox3.Value = True Then Worksheets(2).Range("S7") = "3000" Else Worksheets(2).Range("S7") = "0" End If If CheckBox4.Value = True Then Worksheets(2).Range("T7") = "1500" Else Worksheets(2).Range("T7") = "0" End If Unload Me End Sub <ユーザーフォーム2> Private Sub CommandButton1_Click() Sheet2.Range("V7") = TextBox1 Sheet2.Range("W7") = TextBox2 Sheet2.Range("X7") = TextBox3 Unload Me End Sub

  • 別シートから検索・抽出(VBA)

    Private Sub Worksheet_Change(ByVal Target As Range) Dim ret If Target.Address = "$B$2" Then Set ret = Workbooks("抽出.xlsm").Sheets("抽出元").Range("A:A") _ .Find(ActiveSheet.Range("B2").Value) ActiveSheet.Range("C2").Value = ret.Offset(0, 5).Value ActiveSheet.Range("D2").Value = ret.Offset(0, 6).Value ActiveSheet.Range("E2").Value = ret.Offset(0, 7).Value ActiveSheet.Range("F2").Value = ret.Offset(0, 4).Value ActiveSheet.Range("G2").Value = ret.Offset(0, 2).Value ActiveSheet.Range("H2").Value = ret.Offset(0, 8).Value ActiveSheet.Range("I2").Value = ret.Offset(0, 9).Value ActiveSheet.Range("J2").Value = ret.Offset(0, 10).Value End If End Sub 上記のようなマクロで  選択したセルの値を検索(必ずB列)  選択セルと同じ行に抽出した各データを書き込み(選択セルがB5の場合 C5,D5,E5…に書き込む) ようにするにはどのように書き換えたらいいのでしょうか。 変数で行を取得して…など試したのですがどうもうまくいきません。 どなたかお願いします。 オートフィルタも考えたのですが諸事情で見出しを揃えることができない為諦めました。 現在はVLOOKUP関数で処理を行っていますが既に24000近いセルに式が入っており、データは重くなるし非効率的な気がします。

  • エクセルマクロ_テキストボックスをシートに反映(その2)

    エクセルマクロ初心者です。(2003使用_ユーザーフォーム) 先ほどは大変お世話になりました。 複数行に応用させようとしたのですが、管理番号が余計に記載(テキストボックス(出荷日など)が空欄であっても、管理番号だけはとられてしまいます)されてしまいます。すみませんが、ご教授よろしくお願いいたします。 リストボックス1のデータは、Sheet1を表示しています。→管理番号はSheet2のA最終行に記載されます。 テキストボックス1(回答日)は、上記の管理番号記載のとなりに、 テキストボックス2(出荷日)は、テキストボックス1記載のとなりに、 ・・・とテキストボックス4(コメント)(これはK列)に1行で記載されます。 ↑ここまでは、教えていただいたので、完璧なのですが、 テキストボックス2~4までの内容を、あと複数行(4件)追加できるように試してみたのですが、空欄であっても管理番号だけは常に記載されてしまいます。 テキストボックス2と5に記載されている場合は、Sheet2に値を反映させるが、空欄の場合は、値を反映させないようにしたいのです。 (Sheet1=データベース) C5   D5 管理番号 品名 アカ12 りんご アオ56 みかん クロ34 なし クロ89 すいか アオ12 もも (Sheet2=入力シート) A(管理番号)    B(回答日)    C(出荷日)   D(数量)     K(コメント) アオ56        8月9日        8月10日      75     送り先の確認 アオ56                    8月11日      80 クロ34        9月4日        9月5日      80 (今回は、2行で作成した場合のマクロを記載しました) Private Sub UserForm_Initialize() With ListBox1 .ColumnWidths = "0;0;50;50" .ColumnCount = 4 .RowSource = "Sheet1!A5:D" & Worksheets("Sheet1").Range("C" & Rows.Count).End(xlUp).Row End With End Sub Private Sub CommandButton1_Click() If TextBox2.Value Then Dim lRow As Long With Worksheets("Sheet2") lRow = .Range("A" & Rows.Count).End(xlUp).Row .Range("A" & lRow + 1).Value = ListBox1.List(ListBox1.ListIndex, 2) If IsDate(TextBox1.Value) Then .Range("B" & lRow + 1).Value = TextBox1.Value End If If IsDate(TextBox2.Value) Then .Range("C" & lRow + 1).Value = TextBox2.Value End If If IsNumeric(TextBox3.Value) Then .Range("D" & lRow + 1).Value = TextBox3.Value End If .Range("K" & lRow + 1).Value = TextBox4.Value End With End If If TextBox5.Value Then Dim llRow As Long With Worksheets("Sheet2") llRow = .Range("A" & Rows.Count).End(xlUp).Row .Range("A" & llRow + 1).Value = ListBox1.List(ListBox1.ListIndex, 2) If IsDate(TextBox5.Value) Then .Range("C" & llRow + 1).Value = TextBox5.Value End If If IsNumeric(TextBox6.Value) Then .Range("D" & llRow + 1).Value = TextBox6.Value End If .Range("K" & llRow + 1).Value = TextBox7.Value End With End If Dim myCtrl As Control For Each myCtrl In Controls If TypeName(myCtrl) = "TextBox" Then myCtrl.Value = vbNullString End If Next End Sub (ユーザーフォーム) リストボックス1=Sheet1のデータを反映 テキストボックス1(回答日) テキストボックス2(出荷日),テキストボックス3(数量),テキストボックス4(コメント)←1件目 テキストボックス5(出荷日),テキストボックス6(数量),テキストボックス7(コメント)←2件目 ↑1件目のみでコマンドボタンを押した場合は、1件目のみの管理番号取得をしたいのです。が今は、2件目が空欄でも管理番号はとられてしまいます。 長くなってしまいすみません。 どなたかご回答いただければ幸いです。よろしくお願いいたします。

  • インデックスが有効範囲に出ないと出る

    下記のようなVBAを書きました。しかしインデックスが有効範囲にないとメッセージがでるのですが、どこがまちがっているでしょうか?? Sub macro1() Dim i As Long Dim r As Long Worksheets("フェアリスト ").Select Worksheets("csv").Range("A:C").ClearContents For i = 2 To 50 Step 5 If Worksheets("フェアリスト").Cells(11, i + 1) <> "" Then r = Worksheets("フェアリスト").Cells(65536, i + 1).End(xlUp).Row Worksheets("フェアリスト").Range(Cells(11, i), Cells(r, i + 3)).Copy _ Destination:=Worksheets("csv").Range("B65536").End(xlUp).Offset(1) Worksheets("csv").Range("A65536").End(xlUp).Offset(1).Resize(r - 3, 1).Value = Worksheets("フェアリスト").Cells(8, i).Value End If Next i Worksheets("csv").Range("A1:C1").Delete shift:=xlShiftUp End Sub

  • エクセルマクロが重い

    こんにちは。 ご教授くださいませ。 すでに先方が作っているエクセルのシートがありまして、 そのシートの表組み規則にのっとって入力するユーザーフォーム を私のほうで作ったのですが、重いです。 selectの多用はだめ!というところまでは調べたのですが じゃあどうしたらいいかわかりません。 ■ '--------------------8時から If OptionButton1.Value = True Then ActiveCell.Offset(3, -1).Range("A1").Select ActiveCell = UserForm3.TextBox1.Value ActiveCell.Offset(0, 1).Range("A1").Select ActiveCell = UserForm3.TextBox2.Value ActiveCell.Offset(0, 1).Range("A1").Select ActiveCell = UserForm3.TextBox3.Value ActiveCell.Offset(0, 1).Range("A1").Select ActiveCell = UserForm3.TextBox4.Value ActiveCell.Offset(0, 1).Range("A1").Select ActiveCell = UserForm3.TextBox5.Value ActiveCell.Offset(0, 1).Range("A1").Select ActiveCell = UserForm3.TextBox6.Value ActiveCell.Offset(3, 0).Range("A1").Select ActiveCell = UserForm3.TextBox12.Value ActiveCell.Offset(0, -1).Range("A1").Select ActiveCell = UserForm3.TextBox11.Value ActiveCell.Offset(0, -1).Range("A1").Select ActiveCell = UserForm3.TextBox10.Value ActiveCell.Offset(0, -1).Range("A1").Select ActiveCell = UserForm3.TextBox9.Value ActiveCell.Offset(0, -1).Range("A1").Select ActiveCell = UserForm3.TextBox8.Value ActiveCell.Offset(0, -1).Range("A1").Select ActiveCell = UserForm3.TextBox7.Value ActiveCell.Offset(3, 0).Range("A1").Select ActiveCell = UserForm3.TextBox13.Value ActiveCell.Offset(0, 1).Range("A1").Select ActiveCell = UserForm3.TextBox14.Value ActiveCell.Offset(0, 1).Range("A1").Select ActiveCell = UserForm3.TextBox15.Value ActiveCell.Offset(0, 1).Range("A1").Select ActiveCell = UserForm3.TextBox16.Value ActiveCell.Offset(0, 1).Range("A1").Select ActiveCell = UserForm3.TextBox17.Value ActiveCell.Offset(0, 1).Range("A1").Select ActiveCell = UserForm3.TextBox18.Value ActiveCell.Offset(3, 0).Range("A1").Select ActiveCell = UserForm3.TextBox24.Value ActiveCell.Offset(0, -1).Range("A1").Select ActiveCell = UserForm3.TextBox23.Value ActiveCell.Offset(0, -1).Range("A1").Select ActiveCell = UserForm3.TextBox22.Value ActiveCell.Offset(0, -1).Range("A1").Select ActiveCell = UserForm3.TextBox21.Value ActiveCell.Offset(0, -1).Range("A1").Select ActiveCell = UserForm3.TextBox20.Value ActiveCell.Offset(0, -1).Range("A1").Select ActiveCell = UserForm3.TextBox19.Value ActiveCell.Offset(3, 0).Range("A1").Select ActiveCell = UserForm3.TextBox25.Value ActiveCell.Offset(0, 1).Range("A1").Select ActiveCell = UserForm3.TextBox26.Value ActiveCell.Offset(0, 1).Range("A1").Select ActiveCell = UserForm3.TextBox27.Value ActiveCell.Offset(0, 1).Range("A1").Select ActiveCell = UserForm3.TextBox28.Value ActiveCell.Offset(0, 1).Range("A1").Select ActiveCell = UserForm3.TextBox29.Value ActiveCell.Offset(0, 1).Range("A1").Select ActiveCell = UserForm3.TextBox30.Value 'ActiveWorkbook.Save MsgBox "入力しました。", vbInformation, "確認" End If '--------------------8時から(END ■ 基本の流れは... 最初にオプションボタン3つのどれか1個の 選択を求め、その条件に応じて 始基点となるセルが変わります。 で、あとは与えられた表組みを縦や横に 移動しながら、対応するテキストボックスの 値を入れる、という 我ながら頭の悪い方法で^^; .selectではない、スマートな方法があればと思います。 ぜひお知恵を!

  • 印刷後の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にも「不要」と入っていたら、同じ様にキャンセルできる様に出来ますでしょうか? ご回答お願いします

  • ExcelVBA データのコピー範囲について

    あけましておめでとうございます。今年もよろしくお願いします。 Sub Test() Dim myTarget As Range, r As Range, f Set myTarget = Sheets("Sheet1"). _    Range("B2", Sheets("Sheet1").Range("B65536").End(xlUp)) For Each r In myTarget  Set f = Sheets("Sheet2").Columns(1). _    Find(r.Value, Sheets("Sheet2").Range("A1"), Lookat:=xlWhole)  If Not f Is Nothing Then    If r.Offset(0, 3).Value <> f.Offset(0, 3).Value Then      f.Resize(1, 4).Copy Destination:= _      Sheets("Sheet3").Range("A65536").End(xlUp).Offset(1, 0)    End If  End If Next r End Sub 前回の質問で教えていただいたコードなのですが、現時点では、B列のデータを元にして二つのSheetのデータを比較して別Sheetへコピーしているのですが、そのときに、B列以降の(たとえば、B列からX列まで)データはコピーできますが、A列もコピーしたい時はどうすればよいのかで、悩んでいます。どの様に変更すればよいのでしょうか?

  • 2つのマクロを1つにしたい

    いつもお世話になっております。 今回もよろしくお願いいたします。 (1)14のシートがあるのですが、データーのある2から14までのシートを印刷する。 (2)上記のうち、c列のデーターで連続しているセルを結合する。 (1)と(2)を合わせて1つのマクロにしたいのですが、アクティブシート1つにしか(2)のマクロが動きません。 下記のコードの間違いを教えてください。 Sub 契約書目次印刷() Dim Sh As Worksheet Dim t As Long Dim i As Range t = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row 'データーのあるシートだけ印刷 For Each Sh In Worksheets(Array(2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14)) If Sh.Range("A2").Value <> "" Then '連続データーセル結合 For Each i In Range("C1:C" & t) If i.MergeArea(1).Value = i.Offset(1).Value Then Range(i.MergeArea, i.Offset(1)).Merge End If Application.DisplayAlerts = False Next i End If Sh.PrintPreview Next Sh End Sub

専門家に質問してみよう