電子書籍の厳選無料作品が豊富!

Macro5とMacro6を組み合わせて下記のような処理をさせたいのですが方法がわかりません。
お知恵をお貸しください。

1 日付を確認する
2 Macro6でコピー
3 日付にあわせてMacro5で貼り付け
  今日が1日ならC14から貼り付け
  2日ならC25から貼り付け
  3日ならC36から貼り付け
   ・  
   ・
   ・
  31日ならc344から貼り付け

作成したマクロ
' Macro5 Macro
' マクロ記録日 : 2007/4/25 ユーザー名 :
'
' Keyboard Shortcut: Ctrl+r
'
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
Sub Macro6()

' Macro6 Macro
' マクロ記録日 : 2007/4/25 ユーザー名 :
'
' Keyboard Shortcut: Ctrl+q
'
Range("C2:AD12").Select
Selection.Copy
End Sub

A 回答 (4件)

Sub test01()


Dim td, x
td = Day(Date)
x = (td - 1) * 11 + 14
MsgBox "今日は" & td & "日ですので、C" & x & "から貼り付けます。"
With ActiveSheet
.Range("C2:AD12").Copy
.Range("C" & x).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
End With
End Sub
    • good
    • 0

C2:AD12をコピーして、日付によって貼り付ける位置を変えて値として貼り付けるマクロです。

日付を入力するセルは仮にC1としています。マクロに二行目を実際のシートに合わせて修正してください。

Sub Macro6plus5()
Const DtAdrs As String = "C1" '日付が入るセルアドレス
 If IsDate(Range(DtAdrs)) Then
  ActiveSheet.Range("C2:AD12").Copy
  ActiveSheet.Cells(Day(Range(DtAdrs)) * 11 + 3, "C").PasteSpecial Paste:=xlPasteValues
  Application.CutCopyMode = False
 Else
  MsgBox ("日付型で日付を入力してください")
 End If
End Sub
    • good
    • 0

こんな感じでしょうか?



Sub test()

Dim Hizuke As Integer

Hizuke = (Day(Date) - 1) * 11 + 14

Sheets("sheet1").Activate
Range("C2:AD12").Copy

Sheets("sheet2").Activate
Range("C" & Hizuke).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

End Sub
    • good
    • 0

こんな感じでしょうか?


Sub Macro7()
Call Macro6
Cells(Day(Date) * 11 + 3, 3).Select
Call Macro5
End Sub
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!


おすすめ情報