エクセルマクロをすこし 2018年8月24日 何はともあれリスト化実現かな。

単票からリスト化する作業ができそうです。

Offsetを使う予定ではなかったけれどこれが使いやすかったのでまぁ良しとしたいところです。贅沢は敵ですしね。。。

次の予定はもう決めてありますけれど、うまくできるかは定かではない。。。。

  Sub yy()

    Dim Ye, Mo, Da, Filename, SN, toaddress, ccaddress, bccaddress As String

    Dim subject, mailBody, credit As String '

    Dim outlookObj As Outlook.Application

    Dim mailItemObj As Outlook.mailItem

    Dim i, SC As Long

Application.ScreenUpdating = False

SC = ActiveWorkbook.Sheets.Count

i = 1

Do While i <= SC

'Do While i <= 5

Worksheets(i).Copy

Ye = Year(Range("E1")) & "年"

Mo = Month(Range("E1")) & "月"

Da = Day(Range("E1")) & "日"

Filename = Range("B1") & Ye & Mo & Da

ActiveWorkbook.SaveAs ThisWorkbook.Path & "\xxxx\" & Filename & ".xlsx"

PrintCommunication = False

With ActiveSheet.PageSetup

.PrintArea = Range("B2:Q52").Address

.Zoom = 90

.PaperSize = xlPaperA4

.CenterHorizontally = True

.CenterVertically = True

.LeftMargin = Application.CentimetersToPoints(0.8)

.RightMargin = Application.CentimetersToPoints(0.8)

End With

PrintCommunication = True

ActiveSheet.Name = Range("B1") & Year(Range("E1")) & Month(Range("E1")) & Day(Range("E1"))

Dim days As Date

Dim DayCon, dedura1, dedura2, dedura3, dedura4, dedura5, dedura6, dedura7, dedura8, dedura9 As Long

Dim fullname, sagyo1, sagyo2, sagyo3, sagyo4, sagyo5 As String

            With ActiveSheet

            days = .Range("E1").Value

            DayCon = .Range("M6").Value

            fullname = .Range("E7").Value

             dedura1 = .Range("M9").Value

             dedura2 = .Range("M10").Value

             dedura3 = .Range("M11").Value

             dedura4 = .Range("M12").Value

             dedura5 = .Range("M13").Value

             dedura6 = .Range("M14").Value

             dedura7 = .Range("M15").Value

             dedura8 = .Range("M16").Value

             dedura9 = .Range("M17").Value

             sagyo1 = .Range("E19").Value

             sagyo2 = .Range("E20").Value

             sagyo3 = .Range("E21").Value

             sagyo4 = .Range("E22").Value

             sagyo5 = .Range("E23").Value

End With

ActiveWorkbook.Save

ActiveWorkbook.Close

Workbooks.Open ThisWorkbook.Path & "\リスト.xlsx"

ActiveSheet.Range("A1").Select

    With Cells(Rows.Count, 1).End(xlUp)

        .Offset(1, 0) = days

        .Offset(1, 1) = DayCon

        .Offset(1, 2) = fullname

        .Offset(1, 3) = dedura1

        .Offset(1, 4) = dedura2

        .Offset(1, 5) = dedura3

        .Offset(1, 6) = dedura4

        .Offset(1, 7) = dedura5

        .Offset(1, 8) = dedura6

        .Offset(1, 9) = dedura7

        .Offset(1, 10) = dedura8

        .Offset(1, 11) = dedura9

        .Offset(1, 12) = sagyo1

        .Offset(1, 13) = sagyo2

        .Offset(1, 14) = sagyo3

        .Offset(1, 15) = sagyo4

        .Offset(1, 16) = sagyo5

    End With

ActiveWorkbook.Save

ActiveWorkbook.Close

i = i + 1

Loop

Application.ScreenUpdating = True

ActiveWorkbook.Close

End Sub