エクセルマクロをすこし 2018年8月25日 リストから別のリストを作成

リストからさらにリスト作成ということで特にどう繰り返すかがなかなか思いつかなかった。

また、苦労した点は1列目の選択方法と必要な列の数えるところです。

思った通りにはなかなかならず、いろいろな方面から攻めてやっと結果が出たような気がします。これからの展開はカレンダー（Outlookで）の登録です。こちらはVBAを使うか否か、Outlookの機能そのままにしようか迷っています。

数が少ない場合りすとかする過程の中で取り込めて行ける方向で処理ができればと思います。

Googleカレンダーへの登録についてはすでに自分の中で方法が確立しできているのでここには載せないです。

Sub リストから別のリスト作成()

Dim da1 As Date

Dim sagyou1,  As String

Dim i, j, RX, ConC As Long`この辺りはお好みになりそうです

Dim FN As String

Application.ScreenUpdating = False

Range("A1").Select

CR = Cells(Rows.Count, 1).End(xlUp).Row

i = 2`1行目はタイトル行の為2行目からの処理ということで

Do While i <= CR

  ' Cells(i+1, 0).Value

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

  End With

da1 = ActiveSheet.Range("A" & CStr(i)).Value

j = 1

ConC = WorksheetFunction.CountA(Range(Cells(i, 13), Cells(i, 18))) - 1`この行の処理はちょっと代替手段を考えたい

                Do While j <= ConC

                sagyo1 = ActiveSheet.Cells(i, 13 + j).Value

                    ActiveWorkbook.Save

                Workbooks.Open ThisWorkbook.Path & "\リストのファイル.xlsx"

                ActiveSheet.Range("A1").Select

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

                        .Offset(1, 0) = da1

                        .Offset(1, 1) = sagyo1

                          End With

            ActiveWorkbook.Save

            ActiveWorkbook.Close

            Workbooks.Open ThisWorkbook.Path & "\元のリストのファイル名.xlsm"

        j = j + 1

        Loop

i = i + 1

Loop

Application.ScreenUpdating = True

End Sub