VBAコピー範囲について教えてください
- VBAのコピーペーストについて質問です。コピー範囲のJ10の部分を、J列のデータが入力されている最終行としたいです。どのようなプログラムを使えばいいですか？
- VBAコピー範囲のJ10の部分を、J列のデータが入力されている最終行と合わせる方法を教えてください。
- VBAのコピーペーストで、コピー範囲のJ10の部分を、J列のデータが入力されている最終行と一致させる方法を教えてください。
- ベストアンサー
VBAコピー範囲について教えてください。
VBAのコピーペーストの下記プログラムで、 Sub コピー() Dim rng As Range Set rng = Worksheets("2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) With Range("b2:J10") rng.Resize(.Rows.Count, .Columns.Count).Value = .Value End With End Sub コピー範囲 のJ10の部分（データ入力行）が、その都度変わるため、J10の部分を、 J列のデータが入力されている最終行としたいのですが、どのようなプログラムに すればよいのでしょうか。 どなたかよろしくお願いいたします。
- natase211
- お礼率50% (7/14)
- オフィス系ソフト
- 回答数2
- ありがとう数2
- みんなの回答 （2）
- 専門家の回答
質問者が選んだベストアンサー
こんばんは！ せっかくコードをお考えのようですが、 一例です。 コピーがマクロ名になっていますので、 コピー＆ペーストにしてみました。 Sub Sample1() Dim i As Long i = Cells(Rows.Count, "J").End(xlUp).Row Range(Cells(2, "B"), Cells(i, "J")).Copy Worksheets("2").Cells(Rows.Count, 1).End(xlUp).Offset(1) End Sub こんな感じでしょうか？m(_ _)m
その他の回答 (1)
- K Kazz（@JazzCorp）
- ベストアンサー率31% (549/1751)
Option Explicit Sub コピー() Dim rng As Range Set rng = Worksheets("2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) 'With Range("b2:J10") With Range("b2:J" & Cells(Rows.Count, "J").End(xlUp).Row) rng.Resize(.Rows.Count, .Columns.Count).Value = .Value End With End Sub
お礼
早速のご教示ありがとうございました。 いろいろな方法があるのですね、勉強になりました。 ありがとうございました。
関連するQ&A
- エクセル 最終行からの連続コピー
* すぐに回答を！ エクセルC20からI51までデータを１日１行ずつ入力します。 データが入力されている最終行から上に連続する１０行（最終行含む）をコピーしたいのですが、最終行から10行上をどのように認識させたらいいのか、わかりません。Offsetなど試してみましたがダメでした。 よろしくお願いします。 Sub dataコピー() Dim i As Long Dim j As Integer Dim rng As Range '最後尾から10行前までを選択 With Worksheets("月").Range(Cells(20, 3), Cells(51, 10)) For i = Cells(Rows.Count, 1).End(xlUp).Row To -10? If rng Is Nothing Then Set rng = .Rows(i) End If j = j + 1 If j >= 10 Then Exit For Next i 'コピー If Not rng Is Nothing Then rng.Copy Range("M1") Beep Else MsgBox "該当行は存在しません。", 48 End If End With Set rng = Nothing End Sub コードはこちらを参考にしました http://questionbox.jp.msn.com/qa5440189.html
- 締切済み
- オフィス系ソフト
- エクセル 最終行からの連続コピー
エクセルで最終行から上に連続する１０行（最終行含む）をコピーしたいです。 途中、空白行が含まれている場合でも、最終行を特定し、コピーできるようにするには、下記のコードにどう手を加えたらよいでしょうか？ どなたかアドバイスをお願いします。 Sub Test() Dim i As Long Dim j As Integer Dim rng As Range With ActiveSheet 'フィルタ .Range("A1").CurrentRegion.AutoFilter Field:=1 '行選択 With .AutoFilter.Range For i = .Cells(.Cells.Count).Row To 2 Step -1 If .Rows(i).Hidden = False Then If rng Is Nothing Then Set rng = .Rows(i) Else Set rng = Union(rng, .Rows(i)) End If j = j + 1 End If If j >= 10 Then Exit For Next i 'コピー If Not rng Is Nothing Then rng.Copy Worksheets("Sheet2").Range("A1") Beep Else MsgBox "該当行は存在しません。", 48 End If End With End With Set rng = Nothing なお、コードはこちらを参考にさせていただきました。 http://okwave.jp/qa3552420.html?ans_count_asc=1
- 締切済み
- その他MS Office製品
- ＶＢＡ 任意のシートからコピーを始める。
教えてください。 全てのシートをコピーして一つのシートにまとめるプログラムシートを作成しました。 1番目のシートからコピーを始める場合は For i = 2 To Worksheets.Count 2番目のシートからコピーを始める場合は For i = 3 To Worksheets.Count とすればよいのですがこれだといちいちモジュールコードを出して数字を変更しなければならず面倒です。 そこでユーザーフォームのコンボボックスに任意の数字を入れてクリックを押せば希望するシートからコピーを始めるプログラムを作成してみましたがうまくいきません。どなたか教えてくださいませんか。 Sub matome() Dim i As Integer Dim lRow As Long, lCol As Long, lRow2 As Long, lRow3 As Long, SNo As Integer '----何番目からコピーを始めるかを決定します With UserForm2 SNo = .ComboBox1.value End With For i = 1 + SNo To Worksheets.Count With Worksheets(i) lRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1 lCol = .Cells(1, Columns.Count).End(xlToLeft).Column '----シートのデータが2行以上の場合にコピーします If lRow >= 2 Then lRow2 = Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1 If lRow2 < Worksheets(1).Cells(Rows.Count, 5).End(xlUp).Row + 1 Then lRow2 = Worksheets(1).Cells(Rows.Count, 5).End(xlUp).Row + 1 .Activate .Range(Cells(2, 1), Cells(lRow, lCol)).Copy Worksheets(1).Cells(lRow2, 1) End If End With Next i
- ベストアンサー
- Visual Basic
- VBA 範囲選択時エラー
Private Sub Worksheet_SelectionChangeのVBAでA列B列C列でワンクリックで文字が入力できるように設定致しました。 その後、A列からC列を範囲選択してDeleteするとデバック 「実行時エラー 型が一致しません」と出てしまいます。業務上、そのセルのデータは一気に消したいので困っております。どなたか分かる方よろしくお願い致します。 Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim rng As Range, rng_1 As Range, rng_2 As Range Application.EnableEvents = False Set rng_1 = Range("H17:H100") Set rng_2 = Range("I17:I100") Set rng_3 = Range("J17:J100") Set rng_4 = Range("K17:K100") Application.EnableEvents = True Set rng = Intersect(Target, rng_1) If Not rng Is Nothing Then Cancel = True If Target.Value = "" Then Target.Value = "(1)" Else Target.Value = "(1)" End If Else Set rng = Intersect(Target, rng_2) If Not rng Is Nothing Then Cancel = True If Target.Value = "(2)" Then Target.Value = Empty Else Target.Value = "(2)" End If Else Set rng = Intersect(Target, rng_3) If Not rng Is Nothing Then Cancel = True If Target.Value = "(3)" Then Target.Value = Empty Else Target.Value = "(3)" End If Else Set rng = Intersect(Target, rng_4) If Not rng Is Nothing Then Cancel = True If Target.Value = "(4)" Then Target.Value = Empty Else Target.Value = "(4)" End If End If End If End If End If End Sub
- 締切済み
- Visual Basic
- R1C1形式について
Sub 合計() With Range("A2", Range("A" & Rows.Count).End(xlUp)) With .Columns(18) .FormulaR1C1 = "=if(count(rc[-9],rc[-8])=2,rc[-9]*rc[-8],"""")" .Value = .Value End With End With End Sub Sub 差引合計() With Range("A2", Range("A" & Rows.Count).End(xlUp)) With .Columns(8) .Formula = "=IF(COUNT(F2:G2),SUM($F$1:$F2)-SUM($G$1:$G2),"""")" .Value = .Value End With End With End Sub 2つのコードがありますが、1つ目のコードを2つ目のように、.Formula 形式？で変換をお願いできないでしょうか？ －９はＪ列、－８はＫ列としてください。 よろしくお願します。
- ベストアンサー
- オフィス系ソフト
- VBAの検索で回答をいただいたのですが・・・
Excel2010VBAの検索で、シート1のE列（2行目から）の「日時」とシート2のE列（2行目から）の日時が一致した場合、シート2のF列（2行目から）からJ列（2行目から）、またはJ列にデータがない場合は、F列（2行目から）からI列（2行目から）にデータを入力するというプログラムを高速化する方法を回答者様から教えていただきました。 シートの内容としては シート1は、A「年」、B「月」、C「日」、D「時刻」、E「日時」（文字列）、F「データ1」、G「データ2」、H「データ3」、I「データ4」、J「データ5」、（1行目はタイトル） シート2も基本的にはシート1と同じです。 教えていただいたプログラムは以下の通りで、これを元にシート3（シート1と同じ配列）のE列の日時とシート2のE列の日時が一致した行のシート3のF～J列（データ1～データ5）、J列のデータがない場合、F～I列（データ1～データ4）のデータをシート2のK～O列（データ1～データ5）に入力するというプログラムを作りたかったのですが、自分にとってはこのプログラムの内容が理解できないため、どこを修正していいか分かりません。 どなたか解説していただけませんか？ Sub xxx3() Dim myDic As Object Dim S1_v, S2_v Dim i As Long, n As Long, j As Long 'With Workbooks("ブック.xlsm").Worksheets("シート1") With Sheets("Sheet1") j = .Range("E" & Rows.Count).End(xlUp).Row S1_v = .Range("E1").Resize(j, 6).Value '対象範囲を配列に End With 'With Workbooks("ブック.xlsm").Worksheets("シート2") With Sheets("Sheet2") j = .Range("E" & Rows.Count).End(xlUp).Row S2_v = .Range("E1").Resize(j, 6).Value '対象範囲を配列に End With Set myDic = CreateObject("Scripting.Dictionary") For i = 2 To UBound(S1_v) myDic.Add S1_v(i, 1), i 'keyに追加、itemにi Next i For i = 2 To UBound(S2_v) If myDic.exists(S2_v(i, 1)) Then j = myDic.Item(S2_v(i, 1)) S2_v(i, 2) = S1_v(j, 2) S2_v(i, 3) = S1_v(j, 3) S2_v(i, 4) = S1_v(j, 4) S2_v(i, 5) = S1_v(j, 5) S2_v(i, 6) = S1_v(j, 6) Else 'マッチしなかったときの処理 End If Next 'With Workbooks("ブック.xlsm").Worksheets("シート2") With Sheets("Sheet2") j = .Range("E" & Rows.Count).End(xlUp).Row .Range("E1").Resize(j, 6).Value = S2_v End With Set myDic = Nothing Erase S1_v, S2_v End Sub 回答よろしくお願いします。
- ベストアンサー
- その他MS Office製品
- エクセル 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 このようなマクロを組みましたがエラーがでます。どなたか直して頂けませんか？よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- Excel VBA 構文をすっきりさせたい
いつもお世話になっています。 次のような構文を使って、データを別シートに転送するVBAを作成しました。 転送するデータが多い場合、構文が延々続くことになります。 もっとすっきりと記述する方法がありましたらぜひ教えてください。 お力添え、よろしくお願いします。 Sub データ() With ActiveSheet Dim last last = ActiveSheet.Range("b" & Rows.Count).End(xlUp).Row + 1 .Range("b" & last).Value = Worksheets(2).Range("b2").Value .Range("c" & last）.Value = Worksheets(2).Range("c2").Value .Range("d" & last).Value = Worksheets(2).Range("d2").Value 以下同様に続く・・・・ End With End Sub
- ベストアンサー
- Visual Basic
- リストボックスの内容を検索したいが...
エクセル2019を使っています。 添付画像のようにユーザーフォームにテキストボックスとリストボックスを作り、テキストボックスに入力した文字でリストボックスの内容を検索しようとコードを作成しました。 Private Sub TextBox1_Change() Dim LastRow As Integer Dim rng As Range, r As Range With Worksheets("Sheet1") If .AutoFilterMode <> True Then .Range("A1").AutoFilter End If LastRow = .Cells(Rows.Count, 1).End(xlUp).Row .Range("A1").AutoFilter 1, "*" & TextBox1.Value & "*" If .Cells(Rows.Count, "A").End(xlUp).Row > 1 Then Set rng = .Range("A2:A" & LastRow).SpecialCells(xlCellTypeVisible) Else Me.ListBox1.Clear Exit Sub End If End With Me.ListBox1.Clear With Me.ListBox1 For Each r In rng .AddItem r.Value .List(.ListCount - 1, 1) = r.Offset(0, 1).Value Next r End With End Sub Private Sub UserForm_Initialize() Dim LastRow As Integer Dim rng As Range, r As Range With Worksheets("Sheet1") If .AutoFilterMode <> True Then .Range("A1").AutoFilter End If LastRow = .Cells(Rows.Count, 1).End(xlUp).Row Set rng = .Range("A2:A" & LastRow) End With With Me.ListBox1 .ColumnCount = 1 For Each r In rng .AddItem r.Value .List(.ListCount - 1, 1) = r.Offset(0, 1).Value Next r End With ListBox1.ListIndex = 0 End Sub とりあえず検索はできるのですが、使用されていない文字や記号を入力したあとにバックスペースキーで入力した文字や記号を削除するとリストボックスの内容が意図した内容で表示されません。 どこを修正したらいいでしょうか。
- ベストアンサー
- Excel（エクセル）
- エクセル VBA 表示範囲の簡素化
よろしくお願いします。 下記構文の簡素化ができないでしょうか。 CommandButtonが30個ほどあります。 ーーーーーーーーーー Private Sub CommandButton1_Click() Dim rng As Range Application.Goto Sheets("基本台紙").Range("A1") Set rng = Range("A1:D7") Rows.Hidden = True rng.EntireRow.Hidden = False Columns.Hidden = True rng.EntireColumn.Hidden = False rng(1).Select Unload Me UserForm1.Show vbModeless End Sub ーーーーーーーーーー Private Sub CommandButton2_Click() Dim rng As Range Application.Goto Sheets("基本台紙").Range("A1") Set rng = Range("A8:B21") Rows.Hidden = True rng.EntireRow.Hidden = False Columns.Hidden = True rng.EntireColumn.Hidden = False rng(1).Select Unload Me UserForm1.Show vbModeless End Sub ーーーーーーーーーー Private Sub CommandButton3_Click() Dim rng As Range Application.Goto Sheets("基本台紙").Range("A1") Set rng = Range("C8:D21") Rows.Hidden = True rng.EntireRow.Hidden = False Columns.Hidden = True rng.EntireColumn.Hidden = False rng(1).Select Unload Me UserForm1.Show vbModeless End Sub
- ベストアンサー
- Visual Basic
お礼
早速のご教示ありがとうございます。 バッチリです。また、勉強になりました。 早速活用させていただきます。 本当にありがとうございました。