• ベストアンサー

データ群のコピーが効かない

下記のコードは流れるのですが、コピーされていないのです。 Range(Cells(3, 2), Cells((AX - 1), 3)).Value =_ Sheets("Ｂ").Range(Sheets("sheet3").Cells(4, 148), Sheets("Ｂ").Cells(AX, 149)) このコードから原因が推測できますでしょうか？

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

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

＞Sheets("Ｂ").Range(Sheets("sheet3").Cells(4, 148), Sheets("Ｂ").Cells(AX, 149)) がちょっとおかしい気がする。 シート"B"からコピーしたいなら Sheets("Ｂ").Range(Sheets("B").Cells(4, 148), Sheets("Ｂ").Cells(AX, 149)) でどうですか？

catshoes01
質問者

お礼

すみません。ＯＫでした。感謝します。

catshoes01
質問者

補足

あ、すみません。こちらの記載ミスです。おまけに、質問する場所も・・・。このまま続行します。 ご説明の通りです。それで一気に流れたのですが、肝心のコピーがされないのです。ちょっとエクセルのファイルコピーができなかったのでそれも関係あるのかな。と、ハード面の関与も疑っています。 ひとつはＢシートのデータの読み込みが失敗している可能性があります、 データの場所は間違っていません。

  1. カテゴリ
  2. [技術者向] コンピューター
  3. 業務ソフトウェア
  4. グループウェア

関連するQ&A

  • なぜかデータがコピーされない（ExcelVBA)

    お願いします。 Sheets("sheet6").Range("A1:IV65536").ClearContents Xn1 = Sheets("sheet3").Range("B65536").End(xlUp).Row Sheets("sheet6").Range("A1:B" & (Xn1 - 2)).Value = Sheets("sheet3").Range("B3:C" & Xn1).Value このコードでシート６に何もコピーされないのはなぜでしょうか。 シート３のB,C列には数値が並んでいます。 Xn1はカウントされています。(xn=1631)

  • 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列もコピーしたい時はどうすればよいのかで、悩んでいます。どの様に変更すればよいのでしょうか？

  • Excel　VBAデータ登録のスピードアップしたい

    下記のようなコードがあります。 ■input　データ閲覧・登録・編集シート ■data　データを格納するシート inputシートとdataシートでdataの受け渡しを行っているのですが、データレコードを切り替えるだけで20秒ちょっとかかるため、作業効率が悪いです。 この時間を１～２秒ぐらいまで減らすには、どのように修正すれば、いいでしょうか？どうかアドバイスをお願いいたします。 Private Sub datatouroku() ’データを登録する Dim touroku As Integer Dim fRange As Range Set fRange = Sheets("data").Columns(1).Find(What:=Range("BC1").Value, _ LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows) touroku = fRange.Row '検索されたNoの行位置を求める Sheets("data").Cells(touroku, 1).Value = Range("BC1:BE1").Value Sheets("data").Cells(touroku, 2).Value = Range("AX1").Value Sheets("data").Cells(touroku, 3).Value = Range("I4").Value 　　'・・・上記のデータが全部で256件あります。 End Sub －－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－ Private Sub hyouji() 'データを表示させる Dim fRange As Range Dim kensaku As Long Set fRange = Sheets("data").Columns(1).Find(What:=Range("BC1").Value, _ LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows) 　　　If (fRange Is Nothing) Then '見つからなかった？ 　　　MsgBox "入力された顧客コードが存在しません。", vbExclamation 　　　Exit Sub 　　　End If 　　　kensaku = fRange.Row '検索された顧客DCの行位置を求める 　　　 Range("BC1:BE1").Value = Sheets("data").Cells(kensaku, 1).Value 　　　 Range("AX1").Value = Sheets("data").Cells(kensaku, 2).Value 　　　Range("I4").Value = Sheets("data").Cells(kensaku, 3).Value 　　　　'・・・上記のデータが全部で256件あります。 Set trg = Sheets("data").Cells(kensaku, 1) End Sub

  • 抽出データのコピー

    OFFICE2016 AAのシートのＡ列を1件ずつ参照し、BBのシートでそれぞれに対応するデータを抽出し、CCのシートへコピーするマクロを作成していますが、 抽出したデータをコピーした後に保存すると、容量がものすごく大きくなっています。 原因は、コピー後にCCのシートが最終行まで使用されている状態になっているから。 下記は作成途中のマクロです Sub TEST() ' Sheets("CC").Select Cells.Select Selection.ClearContents Dim i As Long i = 1 Dim M As String M = Worksheets("AA").Cells(i, 1).Value Sheets("BB").Select Worksheets("BB").Range("A1").CurrentRegion.AutoFilter Field:=1, Criteria1:=M Columns("A:C").SpecialCells(xlCellTypeVisible).copy Worksheets("CC").Range("B1").PasteSpecial Paste:=xlPasteAll Application.CutCopyMode = False ' Worksheets("BB").Range("A1").CurrentRegion.AutoFilter End Sub 何が原因なのでしょう？ また、その解消法教えていただきたく、よろしくお願いします。

  • VBAのコードを見ていただけませんか

    いつも、ここのサイトの方々には大変お世話になっております。ありがとうございます。 さてexcel2000で、dataというフォームにデータを格納し、メインのシートから、読みに行って編集するデータベースを作成しようとしています。 とあるサイトを参考にして、コードを作成しましたが、いくら頑張ってもどうしてもエラーが出てしまいうまくいきません。 どうか、コードのチェック・修正内容の提案等をいただけないでしょうか？よろしくお願いいたします。 (1)自分で登録した「ＩＤが見つかりません」という表示しかでず、登録が出来ない (2)dataシートのＢ列（２列目）が主キー(ＩＤと呼んでいます） です。（メインのシートとデータを照合させる部分） (3)メインのシートのＩＤはAL1～AQ1行セルまでを結合したセルに保管しています。 (4)下記コードでCommandButton1ボタンを「登録」と命名し、メインシートで入力したデータをdataシートに変更登録、新規に入力したデータも登録できるようにしたい。 (5)スピンボタンでＩＤを変化させて、メインフォーム上のデータも変化させたいけど、こちらも同種のエラーが出てしまう。 ■以下コードです。 Private Sub CommandButton1_Click() Dim fRange As Range Dim fRow As Long If (Range("AL1").Value = "") Then 'IDが入力されていない場合 MsgBox "IDを入力して下さい", vbExclamation Exit Sub End If Set fRange = Sheets("data").Columns(2).Find(What:=Range("AL1").Value, _ LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows) If (fRange Is Nothing) Then 'IDが見つからなかった場合 MsgBox "IDが見つかりません", vbExclamation Exit Sub End If fRow = fRange.row 'IDの行位置を求める Sheets("data").Cells(fRow, 1).Value = Range("AZ1:BE1").Value Sheets("data").Cells(fRow, 2).Value = Range("AL1").Value Sheets("data").Cells(fRow, 3).Value = Range("AA1:AO1").Value Sheets("data").Cells(fRow, 4).Value = Range("D5:E5").Value Sheets("data").Cells(fRow, 5).Value = Range("G5").Value Sheets("data").Cells(fRow, 6).Value = Range("I5").Value Sheets("data").Cells(fRow, 7).Value = Range("D5:F7").Value Sheets("data").Cells(fRow, 8).Value = Range("G6:I7").Value Sheets("data").Cells(fRow, 9).Value = Range("E8:E9").Value Sheets("data").Cells(fRow, 10).Value = Range("G8:G9").Value Sheets("data").Cells(fRow, 11).Value = Range("B11:I24").Value Sheets("data").Cells(fRow, 12).Value = Range("B71").Value Sheets("data").Cells(fRow, 13).Value = Range("C71").Value Sheets("data").Cells(fRow, 14).Value = Range("B73").Value Sheets("data").Cells(fRow, 15).Value = Range("C73").Value Sheets("data").Cells(fRow, 16).Value = Range("B75").Value Sheets("data").Cells(fRow, 17).Value = Range("C75").Value 　　’・・・・全部でfRow122まであります End Sub

  • ＶＢＡ 重複する番号があるときは値を貼り付けない

    すみません。 理解しているのが少しなので、ちょっとシンプルなＶＢＡを書いています。 1つのブックに　登録シート ＝Sheets("登録")　 　　　　　　　　　顧客情報シート＝Sheets("顧客情報") 　　　　　　　　　販売情報シート＝Sheets("販売情報") 　　　　　　　　　売り上げシート＝Sheets("売り上げ") 登録シートのボタンを押すと、登録シートに入力した情報が、 各シートに分かれて値が入るようにしています。 下記がコードです。 Private Sub CommandButton1_Click() Dim row As Integer ★★★ row = WorksheetFunction.CountA(Sheets("顧客情報").Columns(2)) + 1 Sheets("顧客情報").Cells(row, 2).Value = Range("A2").Value Sheets("顧客情報").Cells(row, 3).Value = Range("A5").Value Sheets("顧客情報").Cells(row, 4).Value = Range("B8").Value ★★★ row = WorksheetFunction.CountA(Sheets("販売情報").Columns(2)) + 1 Sheets("販売情報").Cells(row, 2).Value = Range("C26").Value Sheets("販売情報").Cells(row, 3).Value = Range("J1").Value row = WorksheetFunction.CountA(Sheets("売り上げ").Columns(2)) + 1 Sheets("売り上げ").Cells(row, 2).Value = Range("H1").Value Sheets("売り上げ").Cells(row, 3).Value = Range("K6").Value End Sub もっと簡単な書き方あるよ。。。と言われるでしょうが、 私が理解して修正等ができるのが、上記でした。。 やりたいことは、２点です。 (1)重複は貼り付けをしない。 　登録シートのセル　A2に入った数字が、顧客情報シートのＢ列のどこかに、 　既に入力がされていた場合は、★★★で囲まれた部分の値を貼り付けず、 　その先の販売情報のシートに貼り付ける作業へと進めたい。 　ＩＦ　などを使えばできますでしょうか？ 　 (2)各シートに入力したものを貼り付けた際、Ａ2より下から順番に各シートのCells(row, １)の位置に、連番をつけたい。 何卒宜しくお願い申し上げます。

  • 変数を名前に使ったシートにデータをコピーする方法

    いつもお世話になります。 hisworkbookにあるVBAから新たに開いたmyFileにデータをコピーさせようとしています。 myFileである統合.xlsにはあらかじめ該当するシートが作成されています。 myBushoとmyGroupはそれぞれセルの値を参照しています。 それを元に対応するシート名にデータのコピーをしたいのです。 当初workbooks(myFile)をactiveworkbookにしていたのですが、うまくコピーされなかったので、 ファイルパスを記述しました。 sub test() dim cnt as long dim lcnt as long dim myFile as string dim myBusho as string dim myGroup as string cnt = ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row lcnt = ActiveWorkbook.Sheets(myBusho & "_" & myGroup).Cells(Rows.Count, 1).End(xlUp).Row myFile = "C:\統合.xls" myBusho = range("A1").value myGroup = range("A2").value ThisWorkbook.Sheets("Sheet1").Range(Cells(9, 1), Cells(cnt, 21)).Copy _ Workbooks(myFile).Sheet(myBusho & "_" & myGroup).Cells(lcnt + 1, 1) end sub 上記のコードではうまくコピーできませんでした。 よろしくアドバイスのほど、お願いします。

  • Select Case について

    Sub dummy() Dim Dummy As Worksheet Dim SheetName As String Dim i As Integer Dim GEN As Long Dim OTA As Long With Sheets("入力") '3行目～22行目まで For i = 3 To 22 SheetName = Sheets("入力").Range("D3").Value On Error Resume Next Set Dummy = Sheets(SheetName) 'もしシートがあれば・・・ If Err.Number = 0 Then Select Case .Cells(i, 14).Value Case "TK-001" OTA = Sheets("TK-001").Range("B65536").End(xlUp).Row + 1 Sheets("TK-001").Range("B" & OTA).Value = .Cells(i, "H").Value Sheets("TK-001").Range("I" & OTA).Value = .Cells(i, "I").Value Sheets("TK-001").Range("F" & OTA).Value = .Cells(i, "K").Value Sheets("TK-001").Range("G" & OTA).Value = .Cells(i, "L").Value Sheets("TK-001").Range("J" & OTA).Value = .Cells(i, "M").Value End Select 'シートが無ければ・・・ Else '原紙をコピーする Sheets("原紙").Copy BEFORE:=Sheets(1) 'シートの名前を市場コードにする Sheets(1).Name = SheetName End If Next End With On Error GoTo 0 End Sub 上記の通りマクロを組みましたが、以下の事を行うのに悩んでいます。 (1)Select Case が100通りあるのですが、全てCaseを入れるのではなく 　もっと簡単な方法はありますか？ 　※『リスト』シートを作っており、B1～B100までcaseになるコードが入力されています。 　例：　　　B 　　　1　　TK-001 　　　2　　TK-002 　　　3　　TK-003 　　　　　　　・ 　　　　　　　・ 　　　　　　　・ 　　100 　　TK-100 というシートを作っています。 (2)今のマクロではどんな値でもシートがなければシートを作ってしまう状態ですが、 　もし『リスト』シートの中に値があればシートを作る、無ければ作らないというマクロは可能ですか 　

  • VBA コマンドボタンにおけるコードについて

    下記のようなコードを作成しました。 これを簡略化するにはどうすれば良いのでしょうか？ よろしくお願いします。 Private Sub CommandButton1_Click() Sheets("sheet2").Select Select Case UserForm1.ComboBox1.Text Case Is = Sheets("sheet2").Range("A1").Value Sheets("sheet2").Range("B1").Value = "X" Case Is = Sheets("sheet2").Range("A2").Value Sheets("sheet2").Range("B2").Value = "X" Case Is = Sheets("sheet2").Range("A3").Value Sheets("sheet2").Range("B3").Value = "X" Case Is = Sheets("sheet2").Range("A4").Value Sheets("sheet2").Range("B4").Value = "X" Case Is = Sheets("sheet2").Range("A5").Value Sheets("sheet2").Range("B5").Value = "X" ・ ・ ・ End Select End Sub

  • ｅｘｃｅｌ；マクロ；表現をもっと縮小したい

    質問します。下記のようなモジュールで中に同様の数字のみが順に変わるブロック繰り返しが多数あるのですが、もっと簡略化した表現 が可能でしょうか。よろしくお願いします。 Sub usb_count() d = Range("A65536").End(xlUp).Row j = 3 For i = 2 To d Select Case Cells(i, "B") Case Sheets("sheet2").Cells(4, "A") Sheets("sheet2").Cells(4, "B").Value = Sheets("sheet2").Cells(4, "B").Value + 1 If Cells(i, "K").Value = "USB" Then Sheets("sheet2").Cells(4, "C").Value = Sheets("sheet2").Cells(4, "C").Value + 1 Else Sheets("sheet2").Cells(4, "D").Value = Sheets("sheet2").Cells(4, "D").Value + 1 ' End If ‘------------------------------------------------------------------------------------------------------------------------------------ Case Sheets("sheet2").Cells(5, "A") Sheets("sheet2").Cells(5, "B").Value = Sheets("sheet2").Cells(5, "B").Value + 1 If Cells(i, "K").Value = "USB" Then Sheets("sheet2").Cells(5, "C").Value = Sheets("sheet2").Cells(5, "C").Value + 1 Else Sheets("sheet2").Cells(5, "D").Value = Sheets("sheet2").Cells(5, "D").Value + 1 End If ‘----------------------------------------- ‘以下上記の‘-----------から‘-----------で囲まれたブロックが（　）内の数字が６から20まで繰り返され続く が略す End Select Next i End Su

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

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

質問する