質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

90.61%

  • VBA

    1728questions

    VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

複数セルの値を転記したいが、セル一個分しか転記されない

解決済

回答 1

投稿 編集

  • 評価
  • クリップ 0
  • VIEW 591
退会済みユーザー

退会済みユーザー

前提・実現したいこと

画像のエクセルの内容を、別シートに転記してデータベースを作成しようとしています。

発生している問題・エラーメッセージ

画像の黄色いセルの内容しか転記されず、解決できずにいます。

該当のソースコード

Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "D").End(xlUp).Offset(0, 0)

    Dim sagyokingakuCell As Excel.Range
    With copyWs
        Set sagyokingakuCell = _
                .Range( _
                    .Range("B37"), _
                    .Range("B37").End(xlToRight).End(xlDown) _
                )

    End With 'copyWs


    'sagyokingakuCell.Copy
    'pasteCell.PasteSpecial Paste:=xlPasteValues, _
    '                       Operation:=xlNone, _
    '                       SkipBlanks:=False, _
    '                       Transpose:=False
    pasteCell.Value() = sagyokingakuCell.Value()

質問後、試したソースコード①

  pasteCell.Value() = sagyokingakuCell.Value()

質問後、試したソースコード②

        Set sagyokingakuCell = _
                .Range( _
                    .Range("B37:M37"), _
                    .Range("B37:M37").End(xlDown) _
                )

    End With 'copyWs

    pasteCell.Value() = sagyokingakuCell.Value()

質問後、試したコード③

Dim sagyokingakuCell As Excel.Range
Set sagyokingakuCell = copyWs.Range(Cells(37, 2), Cells(37, "13")).Select.End(xlDown).Select

pasteCell.Value() = sagyokingakuCell.Value()


やはり黄色いセルしか選択できていないようで、解決できずにいます。どうぞよろしくお願いいたします。

  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

回答 1

checkベストアンサー

+1

Range("B37").End(xlToRight).SelectでB37から最終行の右端までのセルが取れますか

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2018/01/19 13:27

    早速のご返信ありがとうございます!

    キーボードで検証してみたらよいのですね!
    たしかに、I37までしか選択できませんでした。。

    キャンセル

  • 2018/01/19 13:33

    であれば、Range(Cells(37,2),Cells(37,"何列目のセルまでか入力して")).Selectで試してみてください。

    キャンセル

  • 2018/01/19 13:35

    .Selectの記述は選択範囲の確認ができたら取ってしまって構いません。

    キャンセル

  • 2018/01/19 13:36

    補足ですが
    何列目のセルまでか入力して → M列まで取りたいのであれば13と入れてください。

    キャンセル

  • 2018/01/19 13:41

    早速のご返信ありがとうございます!
    下記に変更してみましたが、黄色くハイライトされてデバッグ画面になってしまいました。構文間違ってるでしょうか??
    Dim sagyokingakuCell As Excel.Range
    Set sagyokingakuCell = copyWs.Range(Cells(37, 2), Cells(37, "13")).Select.End(xlDown).Select

    pasteCell.Value() = sagyokingakuCell.Value()

    キャンセル

  • 2018/01/19 13:46

    Dim sagyoukingakuCell As Range
    Set sagyoukingakuCell = Range(Cells(37,2),Cells(37,13))
    pasteCell.Value() = sagyoukingakuCell

    かな?
    メッセージはなんと出ていますか?

    キャンセル

  • 2018/01/19 13:48

    Range(Cells(37,2),Cells(37,13)).End(xlDown)

    キャンセル

  • 2018/01/19 13:49

    ありがとうございます!
    いただいたコードを試してみましたら、
    sagyoukingakuCellがハイライトされて、「コンパイルエラー:変数が定義されていません」とメッセージでました。

    キャンセル

  • 2018/01/19 13:51

    Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "D").End(xlUp).Offset(0, 0)

    Dim sagyokingakuCell As Excel.Range
    Set sagyokingakuCell = copyWs.Range(Cells(37, 2), Cells(37, 13)).Select

    pasteCell.Value() = sagyoukingakuCell.Value()

    と変更してみても、同じメッセージが出ます。

    キャンセル

  • 2018/01/19 13:51

    sagyoukingakuCellがDimで宣言した文字列と、Setで使用している文字列が等しいことを確認してください。

    誤字かと思われます。

    キャンセル

  • 2018/01/19 13:52

    sagyoukingakuCell → sagyokingakuCellですかねw

    キャンセル

  • 2018/01/19 14:44

    早速のご検証ありがとうございます!
    タイポみつかりました!
    直したところ、まだタイポがあるのかもしれないのですが、
    実行したら下記が今度はハイライトされ、
    「実行時エラー242:オブジェクトが必要です」
    と出てしまいました。
    Set sagyokingakuCell = copyWs.Range(Cells(37, 2), Cells(37, 13)).Select

    キャンセル

  • 2018/01/19 15:10

    .Selectがいらないのと、copyWs.がいらないと思います。
    sagyoukingakuCellはRange型なので、Range()で指定したもの以外不要です

    キャンセル

  • 2018/01/19 15:21

    Dim S1 As Worksheet
    Dim S2 As Worksheet
    'シート1をS1にセット。S1.Cells(1,2)でシート1のA2を参照できます。
    sheet1.Activate
    Set S1 = ActiveSheet
    'シート2をS2にセット。S2.Cells(1,2)でシート2のA2を参照できます。
    sheet2.Activate
    Set S2 = ActiveSheet

    Dim sagyokingakuCell As Range
    'シート1のB37~M37を選択し、その列の最終行までをsagyoukingakuCellに格納します。
    Set sagyoukingakuCell = Range(S1.Cells(37,2),S1.Cells(37,13).End(xlDown))

    'シート2のA1にsagyoukingakuCellの値を貼り付けます。
    S2.Cells(1,1).Value = sagyoukingakuCell.Value

    キャンセル

  • 2018/01/19 15:45

    いろいろやり方があるのですごく単純な方法で結果だけできるようにすると、こうなります。
    'Sheets1にはコピー元のデータがあるシート名を入れてね
    Sheets("Sheet1").Select
    Range("B37", Range("M37").End(xlDown)).Select
    Selection.Copy
    'Sheet2にはコピーしたい先のシート名を入れてね
    Sheets("Sheet2").Select
    Range("B2").Select
    ActiveSheet.Paste

    キャンセル

  • 2018/01/19 15:47

    上の処理は動作確認済みなのでやってみてください。

    キャンセル

  • 2018/01/19 15:50

    わかりやすく、たくさんのアドバイス賜り、大変ありがとうございます!
    いろいろなアプローチの仕方があるのですね!!
    下記で、うまく実行することができたのですが、
    コメントいただいた方法も試してみます!!

    Dim sagyokingakuCell As Excel.Range

    With copyWs
    Set sagyokingakuCell = _
    .Range( _
    .Range("B37"), _
    .Cells(.Rows.Count, "M").End(xlUp) _
    )
    End With 'copyWs

    With pasteWs
    Set pasteCell = .Cells(.Rows.Count, "D").End(xlUp).Offset(1, 0) _
    .Resize(sagyokingakuCell.Rows.Count, sagyokingakuCell.Columns.Count)
    End With 'pasteWS
    pasteCell.Value = sagyokingakuCell.Value

    キャンセル

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 90.61%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

関連した質問

同じタグがついた質問を見る

  • VBA

    1728questions

    VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。