Q&A
コードやエラーはマークダウンのcode機能を利用してご提示ください。
https://teratail.com/questions/238564
Sheet1のA列の値を値が存在する行まで（最終行は都度変わります）都度コピーし、別シート(Sheet2等)へ貼り付けたいと思っているのですが上手くいかないため、相談にのって頂きたく。
なお、Sheet1のA1の値をSheet2のA1に貼り付けた次の処理としては、Sheet1のA2の値をSheet3のA1に貼り付ける仕様にしたいと思っております。
参考書等で調べた結果、変数と繰り返し処理が必要であることが分かったのですが、「応答なし」となってしまいます。
実際に入力したものは、下記の通りです。
誤っている個所等、ご指摘をお願い致します。
Sub 印刷シート作成()
'行カウント､別シートに貼付
Sheets("Sheet1").Select
Dim 行数 As Long '変数「行数」を作成 For 行数 = 1 To Range("A1").End(xlDown).Row '最終行まで繰り返し
Sheets("Sheet1").Range(Sheets("Sheet1").Cells(行数, "A")).Copy _
Destination:=Sheets("Sheet2").Range("A1")
Next 行数
'シートコピー
Dim 最終行 As Long '変数「最終行」を作成 最終行 = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row '最終行の行数を取得 Dim i As Integer For i = 2 To 最終行 Worksheets("Sheet2").Copy After:=Worksheets("Sheet2") Next 最終行
End Sub
恐れ入りますが、よろしくお願い致します。
パソコンの画面を右半分モジュール画面を表示し、左半分Sheet1を表示し
１度、モジュール画面をクリックしてから [F8]キーを押すと、黄色いカーソルが表示されるので シートとソースコードを見ながら確認出来ると思います。コード添付します
>なお、Sheet1のA1の値をSheet2のA1に貼り付けた次の処理としては、Sheet1のA2の値をSheet3のA1に貼り付ける仕様にしたいと思っております。
Sheet1のA列がA10まであるとすると
Sheet1のA1→Sheet2のA1
Sheet1のA2→Sheet3のA1
Sheet1のA3→Sheet4のA1
途中省略
Sheet1のA10→Sheet11のA1
のようにしたいということですか？
＞m.ts10806様
マークダウンを利用せず質問してしまい申し訳ございません。
マークダウンを調べます。
＞syousuke.33様
「F8」でコードが確認できるんですね！
ありがとうございます。
知りませんでした…
また、頂戴したコードを「F8」で拝見します。
＞tatsu99様
tatsu99様の仰る通りのイメージです。
なお、画像添付致しました。
回答3件
0
ベストアンサー
あなたのソースをできるだけ生かすようにしました。
コピー先のシートがない場合は、自動作成します。
VBA
1Sub 印刷シート作成() 2 Dim 行数 As Long '変数「行数」を作成 3 Dim 最終行 As Long '変数「最終行」を作成 4 Dim sheet_no As Long 'コピー先シート番号 5 Dim sheet_name As String 'コピー先シート名 6 Dim sh1 As Worksheet 'Sheet1 7 Application.ScreenUpdating = False '画面を止める 8 9 Set sh1 = Worksheets("Sheet1") 10 最終行 = Cells(Rows.Count, "A").End(xlUp).Row '最終行取得 11 sheet_no = 2 12 For 行数 = 1 To 最終行 '最終行まで繰り返し 13 sheet_name = "Sheet" & sheet_no 14 make_sheet (sheet_name) 15 Worksheets(sheet_name).Cells(1, 1).Value = sh1.Cells(行数, 1).Value 16 sheet_no = sheet_no + 1 17 Next 行数 18 19 Application.ScreenUpdating = True '解除 20 MsgBox "転記終了しました" 21End Sub 22 23'指定されたSheetを検索し、なければ作成する 24Public Function make_sheet(ByVal sheet_name As String) As Boolean 25 Dim i As Long 26 Dim cnt As Long 27 make_sheet = False 28 For i = 1 To Worksheets.Count 29 '指定されたSheetが存在するならFunctionを抜ける 30 If Worksheets(i).Name = sheet_name Then Exit Function 31 Next 32 '新規にSheetを作成し、名前を付ける 33 cnt = Worksheets.Count 34 Worksheets.Add after:=Worksheets(cnt) 35 Worksheets(cnt + 1).Name = sheet_name 36 make_sheet = True 37End Function 38
投稿2020/10/26 11:04
総合スコア5511
tatsu99様
私が作成したものが不足だらけで勉強不足を痛感しました。
まず、コピー先のシート番号やシート名に関する変数について失念しておりました…
私が作成したものでは、シート名を固定していたため、正しく転記できないことに気付きました。
また、私が作成した変数名等を活かして頂いたため、よりイメージしやすかったです。
簡潔にスマートに纏められていたため、初心者の私でも見やすかったです。
おかげさまで業務をスムーズに進められます。
お忙しい中本当にありがとうございました。
0
VBA
コード
Sub 印刷シート作成()
Dim 行数 As Long '変数「行数」を作成
Dim 最終行 As Long '変数「最終行」を作成
Dim i As Long
Dim n As Long
Application.ScreenUpdating = False '画面を止める
'行カウント､別シートに貼付
Sheets("Sheet1").Select
n = Cells(Rows.Count, "A").End(xlUp).Row '最終行取得
For 行数 = 1 To n '最終行まで繰り返し
Sheets("Sheet1").Select Cells(行数, "A").Select Selection.Copy ' "Sheet2"へ貼付 Sheets("Sheet2").Select i = Cells(Rows.Count, "A").End(xlUp).Row + 1 '最終行取得 + 1 Cells(i, 1).Select ActiveSheet.Paste ' "Sheet１"へ戻る Sheets("Sheet1").Select Next 行数 Application.CutCopyMode = False ' コピーモード解除
Application.ScreenUpdating = True '解除
MsgBox "転記終了しました"
End Sub
投稿2020/10/26 09:26
総合スコア312
syousuke.33様
「F8」で1行ずつ処理を見ると非常に分かりやすく、混乱した際に便利だと感じました。
また、私が作成したものを使って頂いたおかげで、より理解が深まりました。
文法もおかしいのにも関わらず、ご協力頂き感謝しております。
お忙しい中本当にありがとうございました。
0
Sheet1のA列の値を値が存在する行まで（最終行は都度変わります）都度コピーし、別シート(Sheet2等)へ貼り付けたいと思っているのですが上手くいかないため、相談にのって頂きたく。
なお、Sheet1のA1の値をSheet2のA1に貼り付けた次の処理としては、Sheet1のA2の値をSheet3のA1に貼り付ける仕様にしたいと思っております。
なさりたいことがよくわからないので、画像を添付していただけませんでしょうか。
添付図はSheet1のサンプルです。Sheet2,Sheet3の画像も添付してください。
画像の切り取りはアクセサリのSnipping Toolを使うと簡単にできます。
投稿2020/10/26 09:12
総合スコア5511
あなたの回答
tips
プレビュー
