• ベストアンサー

データの値取得マクロ

Sub Macro1() ''Worksheets("Sheet1").Activate ' addrw = Range("b65536").End(xlUp).Offset(1).Row Cells(addrw, 2).PasteSpecial end sub でB列の最終行を取得しその後、最終行の次のセルから追加のデータを貼り付けるマクロを作成しました。 このあと、追加のデータを貼り付ける前のB列の最終行の値と貼り付け後のB列の最終行の値を取得したいのですがどうすればいいでしょうか?

  • tkoo
  • お礼率5% (15/254)

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

  • ベストアンサー
  • nobu555
  • ベストアンサー率45% (158/345)
回答No.1

何行目か?なら 貼付前 = addrw - 1 貼付後 = addrw - 1 + 追加データ数 セルの値なら 貼付前セル値 = Cells(addrw - 1, 2).Value 貼付後セル値 = Cells(addrw - 1 + 追加データ数, 2).Value こんな感じで良いのでは? 後は、文字は適宜変更してください。

その他の回答 (1)

  • ham_kamo
  • ベストアンサー率55% (659/1197)
回答No.2

これはあらかじめセル範囲を選択してコピーしておいてから実行するのでしょうか。 もしそうならコピーする行数がわからないので、貼り付けた後の最終行の値は、 Range("B65536").End(xlUp).Value で取得するとよいかと思います。 貼り付ける前の値の取得はNo.1の方の回答でいけるかと思います。

関連するQ&A

  • 行削除のマクロ

    B列~F列にデータが入っていてB列の最終行の下セルを選択しクリップボードのデータを貼り付けた後、貼り付けたデータの最初の3行を削除するマクロを作っています。 Sub Macro1() ''Worksheets("Sheet1").Activate ' addrw = Range("b65536").End(xlUp).Offset(1).Row Cells(addrw, 2).PasteSpecial end sub これでB列の最終行の下にデータを貼り付けることまで出来たのですが貼り付けた最初の3行の削除の仕方がわかりません。 いい方法があれば教えていただけないでしょうか。  例えばB列の10行目まで既に入力されていた場合、11行目からクリップボードのデータを貼り付け(ここまでは上のプログラムで出来ました。)、11行目から13行目を削除したいのですがどうしたらいいでしょうか?

  • エクセル2000でマクロを作成するのに困っています。

    エクセル2000でマクロを作成するのに困っています。 ↓やりたいこと (1)データを一行コピーする (2)別のファイルを開いて、データを値貼り付けする。  ※値を貼り付けるのは、空白のセルに。 (同じように下の列に値貼りつけを順次行い、データを作成する) ----------------------------------------------------------------------------------------- Sub Macro1() ' ' Aファイルの1行をBファイルのA列が空欄の行へ貼りつけ' 'シートの選択' Worksheets("Sheet3").Activate '行を選択コピー' Sheets("Sheet3").Rows("2:2").Select Selection.Copy 'ファイルを開く' Workbooks.Open Filename:="C:\Documents and Settings\hiro\デスクトップ\Book2.xls" 'ファイル選択' Windows("Book2.xls").Activate 'シートを選択しA列が空欄のセルに貼りつけ' Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial xlPasteValues Application.CutCopyMode = False 'ファイルオープン時のシートを選択' Worksheets("Sheet1").Activate 'ファイルを閉じる' ActiveWorkbook.Close SaveChanges:=True '元ファイルに戻る' Windows("100520_一覧.xls").Activate End Sub -------------------------------------------------------------------------------------------- 2003ではうまくいきますが、会社のPCが2000のためか、下記文言でエラーがでます。 'シートを選択しA列が空欄のセルに貼りつけ' Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial xlPasteValues Application.CutCopyMode = False ●エラー表示   438 プロパティまたはメソッドをサポートしてません。 どのように入力すればよいでしょうか。 マクロを今まで一度も作ったことがわからないので、本当にわかりません。 よろしくお願いいたします。

  • マクロを使ったコピペがうまく動作しない。

    あるデータを転記用のブック(月毎にシートが分かれています。シートの内容は同一)に貼り付ける処理を行うため、下記のようなマクロを組んだのですが、何故か貼りつきません。処理終了時には、転記元ブック(シート)で最終処理の範囲(5番目のB287)を選択しています。一体何がいけないのでしょうか? データはA1からPまでで毎月可変しています。 また、転記用ブックが12枚あるため、月を指定してから貼り付けたいのですが、どのようにすればよいでしょうか?(下記は直接シ-トを指定しました) Sub test() Dim 最終行 As Integer '-------------------------------------------- 開始 Windows("21-12.xls").Activate 最終行 = Range("p65536").End(xlUp).Row Sheets("1").Range("A1:p" & 最終行).Select Selection.Copy Windows("転記.xls").Activate Sheets(12月).Select Range("B1").PasteSpecial Paste:=xlPasteValues '-------------------------------------------- 1 Windows("21-12.xls").Activate 最終行 = Range("p65536").End(xlUp).Row Sheets("2").Range("A1:p" & 最終行).Select Selection.Copy Windows("転記.xls").Activate Sheets(12月).Select Range("B83").PasteSpecial Paste:=xlPasteValues '-------------------------------------------- 2 Windows("21-12.xls").Activate 最終行 = Range("p65536").End(xlUp).Row Sheets("3").Range("A1:p" & 最終行).Select Selection.Copy Windows("転記.xls").Activate Sheets(12月).Select Range("B157").PasteSpecial Paste:=xlPasteValues '-------------------------------------------- 3 Windows("21-12.xls").Activate 最終行 = Range("p65536").End(xlUp).Row Sheets("4").Range("A1:p" & 最終行).Select Selection.Copy Windows("転記.xls").Activate Sheets(12月).Select Range("B227").PasteSpecial Paste:=xlPasteValues '-------------------------------------------- 4 Windows("21-12.xls").Activate 最終行 = Range("p65536").End(xlUp).Row Sheets("5").Range("A1:p" & 最終行).Select Selection.Copy Windows("転記.xls").Activate Sheets(12月).Select Range("B287").PasteSpecial Paste:=xlPasteValues --------------------------------------------- 5 End Sub 

  • シート1のC列の最終行をコピーして同じ行に値貼り付けしたい

    シート1のC列の最終行を取得して その行を丸々値貼り付けするマクロを作りたいと思います。 シート3のB18の値をシート1のC列の最終行の1つ下のセルに値貼り付け すると、その行のA、B列に日付が入力される関数が入っています。(下まで) 関数が入ったままだと、うまくいかない時があるので最終行をコピーして値貼り付けしたいのですが、マクロの作り方を教えてください。 シート1の最終行に貼り付け Sheets("Sheet3").Select Range("B18").Select Selection.Copy Sheets("Sheet1").Select Range("C65536").End(xlUp).Offset(1).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False End Sub 最終行をコピーして値貼り付け Dim 最終行 As Integer 最終行 = Range("C65536").End(xlUp).Row Range("A6:C" & 最終行).Select Selection.Copy Sheets("Sheet1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False End Sub このマクロだと、A6からC列の最終行まで全てコピーされてしまうので、C列の最終行のAからC列まで1行だけコピーできないでしょうか?

  • 同一フォルダの複数ブックの値を取得マクロ

    エクセル2010のマクロで困っています。 同一フォルダ内・複数ブックの 「異動表」というシートの特定のセルを抽出し、一覧にするマクロを素人ながら作成しようとがんばっています。 下記、マクロを作成したのですが、 必ず、98件(98ブック)前後でマクロが止まってしまいます。 【Set wb = Workbooks.Open(myfdr & "\" & fname) 'そのブックを開きwbとする。】←ここで止まります。 なぜなのでしょうか??ご教授願います。 Sub (1)() Dim mb As Workbook, wb As Workbook Dim myfdr As String, fname As String, n As Integer Application.ScreenUpdating = False '画面更新を一時停止 Set mb = ThisWorkbook 'このコピー先ブックをmbとする。 myfdr = ThisWorkbook.Path fname = Dir(myfdr & "\*.xlsx") 'フォルダ内のExcelブックを検索 Do Until fname = Empty '全て検索 If fname <> mb.Name Then 'ブック名がこのブックの名前でなければ Set wb = Workbooks.Open(myfdr & "\" & fname) 'そのブックを開きwbとする。 wb.Sheets("異動表").Range("A1").Copy '選択&コピー mb.Sheets("Sheet1").Activate 'コピー先シートを選択してアクティブにする Range("a1048576").End(xlUp).Offset(1, 0).Activate 'データ最終行を選択 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False '形式を選択して貼付→値 wb.Sheets("異動表").Range("b1").Copy '選択&コピー mb.Sheets("Sheet1").Activate 'コピー先シートを選択してアクティブにする Range("b1048576").End(xlUp).Offset(1, 0).Activate 'データ最終行を選択 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False '形式を選択して貼付→値 wb.Sheets("異動表").Range("b4").Copy '選択&コピー mb.Sheets("Sheet1").Activate 'コピー先シートを選択してアクティブにする Range("c1048576").End(xlUp).Offset(1, 0).Activate 'データ最終行を選択 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False '形式を選択して貼付→値 wb.Sheets("異動表").Range("m2").Copy '選択&コピー mb.Sheets("Sheet1").Activate 'コピー先シートを選択してアクティブにする Range("d1048576").End(xlUp).Offset(1, 0).Activate 'データ最終行を選択 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False '形式を選択して貼付→値 wb.Sheets("退職金計算書").Range("d21").Copy '選択&コピー mb.Sheets("Sheet1").Activate 'コピー先シートを選択してアクティブにする Range("e1048576").End(xlUp).Offset(1, 0).Activate 'データ最終行を選択 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False '形式を選択して貼付→値 Application.ScreenUpdating = True 'コピー先のセルの内容を置き換えますか?=YES Application.DisplayAlerts = False '警告表示を出さない Application.CutCopyMode = False 'クリップボードのコピーを消す wb.Close (False) '有無を言わずに保存せず閉じる For Each c In mb.Sheets(mb.Sheets.Count).UsedRange '取り込んだシートの使用範囲に If c.FormulaR1C1 Like "=*!*" Then '他シート参照があれば c.Value = c.Value '値に変更 End If Next n = n + 1 'ブック数をカウント End If fname = Dir 'フォルダ内の次のExcelブックを検索 Loop '繰り返す Application.ScreenUpdating = True '画面更新一時停止を解除 Dim ws As Worksheet '全てのシートの色をなしにする For Each ws In Worksheets ws.Tab.ColorIndex = xlColorIndexNone Next MsgBox UCase(Environ("UserName")) & "さん、" & n & "件のブックをコピーしましました。" _ + Chr(&HD) + Chr(&HA) + "他シートを参照する式だけは値にしておきましたよ。" _ + Chr(&HD) + Chr(&HA) + "" _ + Chr(&HD) + Chr(&HA) + "", , "( ̄ー ̄)v " End Sub

  • 取得した変数の値の一番大きい変数を取る

    エクセル2002使用です。 セル(A~F列)にランダムに入力された列の最終行数を変数で取っています。 その中で最も大きい変数の値を取るコードを記述したいのですが、 良い方法がわかりません。 sub test() Dim rcnt1, rcnt2, rcnt3, rcnt4, rcnt5, rcnt6, rcnt As Integer '最終行の取得 rcnt1 = Cells(65536, 1).End(xlUp).Row rcnt2 = Cells(65536, 2).End(xlUp).Row rcnt3 = Cells(65536, 3).End(xlUp).Row rcnt4 = Cells(65536, 4).End(xlUp).Row rcnt5 = Cells(65536, 5).End(xlUp).Row rcnt6 = Cells(65536, 6).End(xlUp).Row rcnt = "最も大きい変数の値" ←ここがわかりません。 end sub よろしくお願いします。

  • エクセル VBA マクロについて

    VBA初心者です。 Sub 記入() Range("H8", "J14").Copy Range("C" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats Application.CutCopyMode = False Range("H15", "J21").Copy Range("C" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats Application.CutCopyMode = False Range("H22", "J28").Copy Range("C" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats Application.CutCopyMode = False Range("K13").Select End Sub こういうマクロを作り上手く作動しましたのでB列に日付を記入したいと思い Sub 日付() Range("("B" & Rows.Count).End(xlUp).Offset(1)","("C" & Rows.Count).End(xlUp).Offset(0, -1)").Value = Date End Sub このようなマクロを組みましたがエラーがでます。どなたか直して頂けませんか?よろしくお願いします。

  • エクセルでマクロを組み始めたばかりのため、皆様にご

    エクセルでマクロを組み始めたばかりのため、皆様にご教授頂ければと思います。 今開いているシートに転送ボタンを作成します。このシートのセルC4からC27までデータ(言葉や数値など)を、ボタンを押して、デスクトップ内の「マクロ」というブック、「記録用紙」名のシートにB列に横へ(B4,C4…)、毎日データ転送しようと思います(4行目,5行目…)。 その際、転送先はシート保護をしておきたいのです。 Option Explicit Private Sub CommandButton1_Click() Call Macro1 End Sub Sub Macro1() Range(”C4:C27”).Select Selection.Copy Workbook.Open ”C:¥Users¥user¥Desktop¥マクロ.xlsm” Workbooks(”マクロ.xlsm”).Activate Sheets(”記録用紙”).Select Range(”B65536”).End(xlup).Offset(1).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _:=False, Transpose:=True Windows(”マクロ.xlsm”).Activate End Sub この様なマクロを組んでみました。転送ボタンを押しても、「保護の為、読み取り専用」というエラーメッセージが出て途中で止まってしまいます。 どの様に修正すれば良いのでしょうか?お手数をおかけして申し訳ございませんが、よろしくお願いします。

  • マクロを使って・・・

    シート1に入力したデータをシート2にコピーするいうマクロを作りました。 シート2にコピーはできるのですが 例えば、そのデータを消して再度新しいデータを入れていきたいと思い エクセル左上のシート全体を選択して「Delete」を押すと 会社のエクセル(2003?)は中断モードがどーのこーのとエラー画面が出て マクロが黄色になって、前に進めません。 やり方が決まっているのでしょうか? コピーした行全体を選択して右クリック「削除」とすると エラー画面が出ません。 やり方など決まっているのでしょうか? ↓がんばって作ったマクロです Sub 正方形長方形4_Click() Call macro01 Call macro02 End Sub Sub macro01() Dim ws1 As Worksheet, ws2 As Worksheet Dim x As Long, y As Long Set ws1 = Sheets("Sheet1") Set ws2 = Sheets("Sheet2") x = ws2.Cells(Rows.Count, "b").End(xlUp).Row + 1 y = ws1.Cells(Rows.Count, "b").End(xlUp).Row ws1.Cells(21, "b").Resize(y, 9).Copy ws2.Cells(x, "B").PasteSpecial Paste:=xlPasteValues  ←この行が黄色になります Application.CutCopyMode = False End Sub Sub macro02() Worksheets("Sheet1").PrintOut End Sub

  • エクセルVBAで行のコピー貼り付けについて

    初心者、勉強中でエクセル2007です。 A1行からK40行までの表があります。 これを下にコピーをしながら増やしていってるのですが、マクロでしようと思い下記のとおり 考えました。 selecion.row.Offset(39, -1).Select ここでオブジェクトが必要ですと出ます。 それからその下の?とを色々ぐぐってみますがどうしてもわかりません。 それと2007ですので65536行ではないのですが、MaxRow = Cells(Rows.Count, 1).End(xlUp).Row だと動かないみたいですので下記としています。 よろしくご教授お願いします。 Sub Gcopy() MaxRow = Range("B65536").End(xlUp).Offset(-39, -1).Select データの入ってる最終行を取得 Selecion.row.Offset(39, -1).Select 選択された行から上に39行移動し選択 ?                    下へ39行まで選択   MaxRow = Range("B65536").End(xlUp).Offset(1, -1) 最終行を取得 ActiveSheet.Paste 貼り付け End Sub

専門家に質問してみよう