Excel2013VBA列選択の拡大

このQ&Aのポイント
  • Excel2013VBAの列選択の拡大について教えてください。
  • 選択範囲のコピー貼り付けはできているが、列幅がコピーされていない理由を教えてください。
  • AX3からCC3までの列を取得選択コピーして貼り付けたいが、列幅が違ってしまう問題への解決策を教えてください。
回答を見る
  • ベストアンサー

Excel2013VBA列選択の拡大

ExcelVBA2013です。 列の取得でつまづいております。 お手数ですが、ご教授下さい。 下記のコードで選択範囲のコピー貼り付けは出来ていますが、列幅がコピーされていませんでした。 CC3のセルを基準にOffsetとResizeで範囲拡大してコピーしているためだと思います。 CC3の左隣のAX3:CB3はセル結合されています(○月)。(その下の4行目は日付の1~31が入力) 列は、今回はAX3:CC3まで(1月分)取得できればよいです。(可変します) MaxCol = Range("J5").End(xlToRight).Column  で列取得できます。 行の位置は、MaxRow = Range("I5").End(xlDown).Row  で取得した値です。 それで、列全体を取得しようと、 MaxCol = Columns(MaxCol).Select で最終列は取得できましたが、そこから列選択の拡大ができればと思っています。 現在は、AX3:CC237まで取得コピーして、隣の列に貼り付けで列幅が違う。 希望はAX:CCまでの列を取得選択コピーして貼り付け。 Sub SAMPLE() Dim MaxRow As Variant, MaxCol As Variant Dim r As Range, c As Range MaxRow = Range("I5").End(xlDown).Row '最終行番号 MaxCol = Range("J5").End(xlToRight).Column '最終列番号 Set c = Cells(3, Cells(3, Columns.Count).End(xlToLeft).Column) '表の右上角のセル番地を取得 c.Select c.Offset(0, -31).Resize(MaxRow - 2, 32).Copy c.Offset(0, 1) '表右上から1月分選択範囲拡大してコピー隣の列より貼りつけ End Sub

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

  • ベストアンサー
  • keithin
  • ベストアンサー率66% (5278/7940)
回答No.2

>列幅がコピーされていませんでした。 ご相談の直接の回答としては 変更前: c.Offset(0, -31).Resize(MaxRow - 2, 32).Copy c.Offset(0, 1) 変更後: c.Offset(0, -31).Resize(MaxRow - 2, 32).entirecolumn.Copy destination:=cells(1, c.column + 1) とかで十分です。

hinoki24
質問者

お礼

試してみました。 思い通りに出来ていました。 どうもありがとうございました。

その他の回答 (1)

  • weboner
  • ベストアンサー率45% (111/244)
回答No.1

やりたいことは、 3行目の最終セルが結合してる列の最終セルまでを、結合セルの隣に列幅も含めてコピーする でいいのかな? Cells(3, Cells(3, Columns.Count).End(xlToLeft).Column).Select Range(Selection, Selection.End(xlDown)).Copy Selection.Offset(, 1).PasteSpecial xlPasteAll Selection.PasteSpecial Paste:=xlPasteColumnWidths

hinoki24
質問者

お礼

解決しました。 どうもありがとうございました。

hinoki24
質問者

補足

関係ないかもしれませんが、1点もれがありました。CC3:CC4は結合しています。 試してみました。 1行目のコードで、CC3を選択していました。 2行目以降で、CC3のみしかコピーされず、隣にはりつけていました。 CC列は合計列で、その左に31列(1か月分)あります。さらに、その左も同じように前月分が存在しています。 合計欄も含め、最右側にある1か月分を列毎コピーしたいと思っています。 AX:CCの列全体選択→コピー→CDに貼り付け。 CCを選択して、そこから、31列さかのぼって、列全体を選択出来ればと思っているのですが、列全体を選択できないでいます。 これで分かりますでしょうか?他に情報が必要でしたら、教えてください。すいません。お手数かけます。

関連するQ&A

  • エクセルのVBAコードにつてい

    以下のコードについて、その内容をまだ自分の知識では理解できず困っておりまして、アドバイスいただければと思いまして書き込みました。 『コード』 Sub Test() Dim Lc As Integer Dim Ct As Integer Dim MyR As Range Dim C As Range Dim D As Range Lc = Range("A1").End(xlToRight).Column - 2 For Each C In Range("B2", Range("B65536").End(xlUp)) Ct = WorksheetFunction.Count(C.Offset(, 1).Resize(, Lc)) If Ct > 0 Then Set MyR = C.Offset(, 1).Resize(, Lc).SpecialCells(2, 1) For Each D In MyR With Sheets("Sheet2").Range("A65536").End(xlUp) .Offset(1).Value = C.Value .Offset(1, 1).Value = Cells(1, D.Column).Value End With Next Set MyR = Nothing End If Next With Sheets("Sheet2") .Columns("A:B").AutoFit .Activate End With End Sub 『質問』 1.「Lc = Range("A1").End(xlToRight).Column - 2」の部分の解釈は「A1から右方向に一番最後のセルまでを範囲指定し、その一番右のセルの列番号を取得する」変数という解釈でいいのか 2.「Ct = WorksheetFunction.Count(C.Offset(, 1).Resize(, Lc))」の部分の変数はどういった値の整数を取得する変数なのか 以上2点についてアドバイスいただけると幸いです。

  • VBA データの統合機能

    Winは7、Excelは2013を使用しています。 以前、データの統合機能というのをこちらで教わり、 その構文を使用させて頂いているのですが、 下記の、方法を集計のところの、Rnage("A7")のところに、変数 rnを使用したいのですが、 エラーコード438が出てしまいます。 あと、年間集計のところにデータを書きだすところで、画像の青枠の様に1列おきに書き出したいのですが、可能でしょうか? 以上、2点ご教示頂けますようお願い致します。 Sub test_データの統合機能() Dim sArray() As String ReDim sArray(Sheets.Count - 2) As String Sheets("年間集計").Select Cells.ClearContents '-------------------------------------------- '科目年間集計 '-------------------------------------------- For i = 2 To Sheets.Count sShtName = Sheets(i).Name sShtAddress = Sheets(i).Range("M2").CurrentRegion.Address(, , xlR1C1) sArray(i - 2) = sShtName & "!" & sShtAddress Next i Sheets(1).Range("A1").Consolidate Sources:=sArray, _ Function:=xlSum, _ TopRow:=True, _ LeftColumn:=True, _ CreateLinks:=False '-------------------------------------------- '合計 '-------------------------------------------- Dim maxCol As Long Dim maxRow As Long Dim c As Integer Dim r As Integer maxCol = Range("A2").End(xlToRight).Column maxRow = Range("A2").End(xlDown).Row Cells(1, maxCol + 1) = "合計回数" Cells(1, maxCol + 2) = "合計時間" For r = 2 To maxRow For c = 2 To maxCol Step 2 Cells(r, maxCol + 1) = Cells(r, maxCol + 1) + Cells(r, c) Cells(r, maxCol + 2) = Cells(r, maxCol + 2) + Cells(r, c + 1) Next c Next r '-------------------------------------------- '方法を年間集計 '-------------------------------------------- Dim rn As Range Set rn = Cells(maxRow + 2, 1) For i = 2 To Sheets.Count sShtName = Sheets(i).Name sShtAddress = Sheets(i).Range("Q2").CurrentRegion.Address(, , xlR1C1) sArray(i - 2) = sShtName & "!" & sShtAddress Next i Sheets(1).Range("A7").Consolidate Sources:=sArray, _ Function:=xlSum, _ TopRow:=True, _ LeftColumn:=True, _ CreateLinks:=False '-------------------------------------------- 'このあとに合計を計算する '-------------------------------------------- '(略) End Sub

  • アプリケーション定義またはオブジェクト定義のエラー

    VBAを勉強し始めて1週間ほどになります。 そこで、掲題のエラーが出てしまい、何が原因か分からず途方にくれてます。 掲題のエラーで検索すると、同じようなエラーで悩んでいる人がいますが、 私の事例を解決する案を見つけることが出来ませんでしたので、 今回質問させていただきます。 まず、下記で示すプロシージャとは別のSUBプロシージャで計算し、表を 作成します。表は、計算条件によって行数が変わります。 その表をクリアさせるのに、下記で示すSUBプロシージャを作成しました。 Public Sub 値のクリア() Dim a_clr As Integer 'A列の縦の値 Dim b_clr As Integer 'B列の縦の値 Dim MaxRow As String '表の最終行を取得 Dim MaxCol As String '表の最終列を取得 MaxRow = Cells(Rows.Count, 4).End(xlUp).Row '表の行の最終行を取得 MaxCol = Cells(7, Columns.Count).End(xlToLeft).Column '表の列の最終列を取得 MsgBox (MaxRow) MsgBox (MaxCol) Worksheets("計算").Range("d7", Cells(MaxRow, MaxCol)).ClearContents ← エラーになる。 Worksheets("計算").Range("d7", Cells(MaxRow, 16)).ClearContents    ←問題なく動作します。 End Sub これを動作させると、掲題のエラーが出ます。 エラーが出る箇所は、Rangeプロパティの行です。 プログラム中にも書いてますが、書き方により動作したり しなかったりします。 Range("d7", Cells(MaxRow, MaxCol)).ClearContents ← エラーになります。 Range("d7", Cells(MaxRow, 16)).ClearContents    ← 問題なく動作します。 デバッグモードの時に、Cells(MaxRow, MaxCol))の中の変数(MaxRow, MaxCol)にマウス を持っていくと、数値が表示されます。 その数値は、私が必要としている数値がきちんと入っています。 それなのに、なぜここでとまっているのか分かりません。 また、Cells(MaxRow, MaxCol)をCells(MaxRow, 16)の用に数値にすると 問題なく動作する理由もよく分かりません。 変数の指定の仕方などが悪いのか、今一理解しきれていないのが原因かも 知れませんが、アドバイスをいただけると助かります。 よろしくお願いします。

  • エクセル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

  • EXCEL2010マクロSeetの結合

    始めまして、宜しくお願い致します。EXCEL2010のマクロで以下の事をしたいと思っております。 一つのBook内に複数Seetがあります。Sheetの代一行目には、氏名、試験結果の点数があります。通常EXCELを開くとSeetが3つ出来ます。Seet4・・・・とSheetを増やしていきます。増やすシートの数は、クラス事に国語、算数、理科と、言う具合に増えていきます。列に関しては、60点以上と言う制限があります。ですから、Sheetは、試験科目毎点数に依存しますのでまちまちです。そして、Sheet4から始めます。行は固定であります。これらのSheetを一つのSheetにまとめて新しいBookを作りたいと思います。以下にマクロを書いてみました、しかし、列の最大値を取って、別のSheetのコピーするところで、結果として、で出来ませんでした。どなたかお分かりになる方何卒アドバイスをお願い申し上げます。 Dim sheetsuu As Integer sheetsuu = ActiveWorkbook.Sheets.count Sheets(sheetsuu).Select Sheets.Add For yy = sheetsuu - 3 To sheetsuu Step 1 MaxRow = Range("A1").End(xlDown).Row '列の最終列の算出。 MaxCol = Range("A1").End(xlToRight).Column '行の最終行の算出。 Sheets("sheetsuu").Select Rows(MaxRow, MaxCol).Select Selection.Copy Application.CutCopyMode = False

  • excel vba データの有る最後の列

    Excel VBAでデータの入っている最後の列を知りたい。 下記のように A1 形式では、大丈夫でした。 temps="C3" LastColumn = ActiveSheet.Range(temps).End(xlToRight).Column ところが、サーチする箇所を変数にしたいため、下記のように記述すると 「実行時エラー1004 アプリケーションの定義またはオブジェクト定義のエラーで す。」となってしまいます。 I=2,J=3 LastColumn = ActiveSheet.Range(cells(i,j)).End(xlToRight).Column 何か良い方法は無いでしょうか。

  • Excelシートの行数(列数)GET

    Excelシートの行数(列数)GET お世話になります。 Excel2000/Excel2007ではワークシートのサイズ(行/列)が異なります。 VBAマクロを作成する時、最大サイズ(行/列)を取得する方法として、 現在は次の方法で対処しているのですが、 更に気のきいた方法があればその方法を紹介して頂きたいのですが?。 宜しくお願いします。 MaxRow = Range("B" & Rows.Count).End(xlDown).Row '…Max行:65536(1048576) MaxCol = Cells(2, Columns.Count).End(xlToRight).Column '…Max列: 256( 16384) 以上

  • Excel2000VBAで貼り付け先の取得等・・・

    シートに行数13、列数不定の表が上下に多数配置されてます。表は上下それぞれ2行の空白行で隔てられています。 各表は連続した列の部分でひとつですが、中には複数の表を横にならべて、途中1列の空白列で間隔をあけたものもあります。 この、複数の表を横に並べたものを上下に配置しなおすため、以下のように書きました。 質問です。 1.Dim ans As Variantは 'variantで正しいですか? 2.15行(13行+間隔用2行)挿入にForNext以外にいい方法はないですか? 3.切り取った部分を貼り付ける際、Set XRng = SelectionでなくセレクトせずにXRngを取得できませんか? 他に指摘事項があればお願いします。 Sub TEST() Dim ans As Variant Dim Rng As Range, XRng As Range Dim c As Integer, b As Integer, i As Integer, n As Integer, x As Integer ans = MsgBox("分離したい表を選択してある?", vbYesNo + vbQuestion) If ans = vbNo Then Exit Sub Set Rng = Selection b = Application.CountBlank(Range(Rng(2, 1), Rng(2, Rng.Columns.Count))) '分離する数を取得 Set XRng = Rng For i = 1 To b'分離する数だけ繰返し For n = 1 To 15 '行挿入 XRng.Offset(14, 0).Resize(1, 1).EntireRow.Insert Shift:=xlDown Next n c = XRng.Columns.Count '列数取得 x = Range(XRng(1, 1), XRng(1, 1).End(xlToRight)).Columns.Count '最左側部分の列数取得 XRng.Offset(0, x + 1).Resize(13, c - x - 1).Cut '右側カット Rng.Offset(15 * i, 0).Resize(1, 1).Select '貼付け開始位置セレクト ActiveSheet.Paste '貼付け Set XRng = Selection 'XRng再取得 Next i End Sub

  • VBA 空白になるまでLOOPしたい

    VBA初心者です。切羽詰っています。 みようみまねで作成しています。 シートAの一部をシートBにコピーしたいです。 シートAのB列が空白になるまでコピーを続くように設定をしたいのですが・・・ 以下の内容では、進みません。。。どこがダメなのでしょうか? Dim CTarget As Range, PTarget As Range, XTarget As Range '変数をRange(領域)で宣言 'コピー元・貼り付け先を設定 Set XTarget = Worksheets("シートA").Range("B列") '空白チェック元 Set CTarget = Worksheets("シートA").Range("B3:AI3") 'コピー元 Set PTarget = Worksheets("シートB").Range("B15:B19") '貼り付け先 '以降、コピー元が空白になるまで繰り返し処理 Do Until XTarget = "" PTarget = CTarget '貼り付け先にコピー元を入力 Set CTarget = CTarget.Offset(1, 0) 'コピー元を 下方向に1個ずらす Set PTarget = PTarget.Offset(5, 0) '貼り付け先を下方向5個にずらす Loop End Sub

  • VBA、セルの選択範囲について

    下記のような表を用意し、   A   B  C  D  E 1    1月 2月 3月 合計 2 Aさん 1  2  3  6 3 Bさん 1  2  3  6 4 Cさん 1  2  3  6 5 合 計 3  6  9  18 セルの範囲選択を指定し別シートの任意のセルへコピーをVBAで行いたいのですが、 Aさん、Bさん、Cさんという範囲を選択する為に、合計という文字は含みたくないので、 Range("A2").Select Range(Selection, Selection.End(xlDown).Offset(-1)).Select と記載し、これは出来ました。 同様に、 1月、2月、3月という範囲も同様にxlToRightを使用し選択出来ました。 Range("B1").Select Range(Selection.End(xlToRight).Offset(, -1), Selection).Select しかし、B2:D4の範囲の指定の仕方がわかりませんでした。 データのレコード数は一定ではないのでB2:D4というように範囲を指定する事は出来ません。 そのときに応じてDさん、Eさんと増えたり、4月、5月と増えたりするので。 何か方法があればご指導お願いします。

専門家に質問してみよう