ここから本文です

すみません。

mac********さん

2020/2/2720:03:32

すみません。

素人で何とか以下まで作れたのですが、

Sub torikeshi01()

Dim i

For i = 5 To Sheets("追加取消一覧").Range("C1000").End(xlUp).Row + 1

If Sheets("追加取消一覧").Range("C" & i).Value = "" Then


Sheets("1月").Select
Range("A4039:CH4039").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("追加取消一覧").Select
Sheets("追加取消一覧").Range("C" & i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


Exit For


End If

Next


End Sub
Sub torikeshi02()

Dim i, o

For i = 5 To Sheets("追加取消一覧").Range("C1000").End(xlUp).Row + 1

If Sheets("追加取消一覧").Range("C" & i).Value = "" Then

Sheets("2月").Select
Range("A4039:CH4039").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("追加取消一覧").Select
Sheets("追加取消一覧").Range("C" & i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


Exit For

End If

Next

End Sub
Sub torikeshi03()
Dim i

For i = 5 To Sheets("追加取消一覧").Range("C1000").End(xlUp).Row + 1

If Sheets("追加取消一覧").Range("C" & i).Value = "" Then

Sheets("3月").Select
Range("A4039:CH4039").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("追加取消一覧").Select
Sheets("追加取消一覧").Range("C" & i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False



Exit For


End If

Next

End Sub

今、A列とB列が空欄になっています。
値貼り付けをした分その月を入れたいのですが、どのような構文をどこに入れたらよいでしょうか。
例えば、1月のマクロ(sub torikesi01)を実行したら、C列の5~6行目まで値貼り付けを
して、その2行分のA列に1月、B列に取消という感じです。
A B C
︙︙︙:
5 1月 取消 100
6 1月 取消 50
7
8

A列、B列に関数を入れてもよいのですが、いっそのことマクロボタン1つで事足らせたい
と思いまして、こちらに投稿させていただきました。
ご面倒かもしれませんが、どうぞお知恵を拝借いただけませんでしょうか。
どうぞよろしくお願いいたします。

閲覧数:
31
回答数:
1

違反報告

回答

1〜1件/1件中

プロフィール画像

カテゴリマスター

tra********さん

2020/2/2723:34:03

同じようなプロシジャを12個もつくるんですかね?
とりあえず、お示しのコードを纏めると、↓のような感じがいいのでは?
もっと機能的にまとめることもできそうですが、初心の方は消化不良になるでしょう。もうすこし上達してから考え直してもよいかと。
未実行です。

Sub torikeshi01()
Call MonthlyProc("1月")
End Sub

Sub torikeshi02()
Call MonthlyProc("2月")
End Sub

Sub torikeshi03()
Call MonthlyProc("3月")
End Sub

Sub MonthlyProc(xMonth As String)
Dim i As Long, sh As Worksheet, rng As Range
Set sh = Worksheets(xMonth)
With Worksheets("追加取消一覧")
For i = 5 To .Range("C1000").End(xlUp).Row + 1
If .Range("C" & i).Value = "" Then
With sh.Range("A4039:CH4039")
Set rng = sh.Range(.Cells, .Cells.End(xlDown))
End With
rng.Copy
.Range("C" & i).PasteSpecial Paste:=xlPasteValues
With .Range("A" & i).Resize(rng.Rows.Count)
.Value = xMonth
.Offset(, 1).Value = "取消"
End With
Exit For
End If
Next i
End With
End Sub

この質問につけられたタグ

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる