マクロで出力したCSVの最後に,,,が出てくる

Question

ご覧いただきありがとうございます。

ExcelVBAでの質問です。

データを取り込んだ後成形し、別ブックにCSV形式で保存するマクロなのですが
なぜかCSVに最終行に数行,,,とからの項目が出てしまします。
コードとして未熟な部分が多々ありますがなぜこうなるのかご教授ください。
単純に最終行から9999行を行削除してみたのですが消えませんでした。
コードを載せますのでご覧ください。
よろしくお願いします。

Option Explicit
'----- 参照設定 Microsoft CDO for Windows 2XXX Library
Public Const myADDRESS As String _
  = "http://schemas.microsoft.com/cdo/configuration/"

Public hi As String
Public strFileName As String
Dim gyo As Long
Dim gyo2 As Long
Dim filecount As Long
Dim sheetcount As Long
Dim unmatch As Long
Dim erfilecount As Long


'ボタンを押したとき
Sub FolderSelect()

    Dim LastRow As Long
    
    '最終行の指定
          
          LastRow = ThisWorkbook.Worksheets(4).Cells(Rows.Count, "B").End(xlUp).Row + 1

          ThisWorkbook.Worksheets(4).Range("A1:K" & LastRow).ClearContents
    
    Dim folderpass As String
    With Application.FileDialog(msoFileDialogFilePicker)
        If .Show = True Then
            folderpass = .SelectedItems(1)
        Else
            ThisWorkbook.Worksheets(1).Range("B3").Value = "キャンセルしました。"
            Exit Sub
        End If
    End With
    
    filecount = 0
    sheetcount = 0
    unmatch = 0
    erfilecount = 0
    gyo = 6
    gyo2 = 2
   
    
    ThisWorkbook.Worksheets(1).Range("B2").Value = "処理中"
    
    Call FileSearch(folderpass, "*.csv")
   Dim dateupdate As String
   dateupdate = Year(Date) & "年" & Month(Date) & "月" & Day(Date) & "日更新"

   ThisWorkbook.Worksheets(1).Range("B2").Value = "完了"
   ThisWorkbook.Worksheets(2).Activate
End Sub
'ファイル検索
Sub FileSearch(Path As String, Target As String)
    Dim FSO As Object, Folder As Variant, File As Variant
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set File = FSO.getfile(Path)
   
            filecount = filecount + 1
            ThisWorkbook.Worksheets(1).Cells(gyo, 1) = File.Name
            ThisWorkbook.Worksheets(1).Cells(gyo, 2) = File.Path
            Call ParCopy(File.Path)

    ThisWorkbook.Worksheets(1).Range("B3").Value = filecount & "個のファイルが見つかりました。"
    'Next File
End Sub
''一覧出力
Sub ParCopy(Path As String)


    Dim openbook As Workbook
    Dim openbooksheet As Worksheet
    Dim lp As Long
    Dim el As Long
    Dim lo As Long
    Dim br As String
    Dim c As Range, Target As Range
    Dim LastRow As Long
    Dim FSO As Object
    Dim FileName_InFolder As String
        
        LastRow = ThisWorkbook.Worksheets(2).Cells(Rows.Count, "B").End(xlUp).Row + 1

        ThisWorkbook.Worksheets(2).Range("A1:K" & LastRow).ClearContents
    
        Application.ScreenUpdating = False

        On Error GoTo myError
        Set openbook = Application.Workbooks.Open(Path)


        'シートを格納
 
            Set openbooksheet = openbook.Worksheets(1)
            openbooksheet.Unprotect
        

        '最終行の指定
          
            LastRow = openbooksheet.Cells(Rows.Count, "B").End(xlUp).Row + 1

          
        'マクロ側へのコピペ
        'データを持ってきて
            openbooksheet.Range("A1:K" & LastRow).Copy ThisWorkbook.Worksheets(4).Range(ThisWorkbook.Worksheets(4).Cells(1, 1), ThisWorkbook.Worksheets(4).Cells(1, 1))
          
            el = 2
          
            Do Until el = LastRow
          
                If ThisWorkbook.Worksheets(4).Cells(el, "C") = "xxx" Then
                
                    ThisWorkbook.Worksheets(4).Rows(el).Delete
          
                End If
               
                el = el + 1
                
            Loop
            
            
          '左三列を値貼り付けして
          
            ThisWorkbook.Worksheets(4).Range("L1:N" & LastRow).Copy
            ThisWorkbook.Worksheets(2).Range(ThisWorkbook.Worksheets(2).Cells(1, 1), ThisWorkbook.Worksheets(2).Cells(1, 1)).PasteSpecial Paste:=xlPasteValues
           
          '残りを持ってくる..
            ThisWorkbook.Worksheets(4).Range("E1:K" & LastRow).Copy ThisWorkbook.Worksheets(2).Range(ThisWorkbook.Worksheets(2).Cells(1, 4), ThisWorkbook.Worksheets(2).Cells(1, 4))
     
            openbook.Close False
          
          
            LastRow = ThisWorkbook.Worksheets(5).Cells(Rows.Count, "G").End(xlUp).Row
            ThisWorkbook.Worksheets(5).Range("G1:P" & LastRow).Copy
          
            LastRow = ThisWorkbook.Worksheets(2).Cells(Rows.Count, "E").End(xlUp).Row + 1
            ThisWorkbook.Worksheets(2).Range(ThisWorkbook.Worksheets(2).Cells(LastRow, 1), ThisWorkbook.Worksheets(2).Cells(LastRow, 1)).PasteSpecial Paste:=xlPasteAll
                
            '誕生日が入って無い人を消す
                
            el = LastRow
                
             Do Until el = 2
             
             
                If Range("I" & el) = "" Then
                
                   ThisWorkbook.Worksheets(2).Rows(el).Delete
                
                End If
              
                el = el - 1
              
              Loop
              
            el = 7
            
            '日付の型を変更
            
            Do Until el = 10
            
               lo = 2
               
               Do Until lo = LastRow
                 
                  
                 ThisWorkbook.Worksheets(2).Cells(lo, el).NumberFormatLocal = "yyyy/mm/dd"
                 
                 lo = lo + 1

               Loop
            
               el = el + 1
            
            Loop
            
            lp = LastRow + 9999
            
            ThisWorkbook.Worksheets(2).Rows(LastRow & ":" & lp).Delete
            
    
            Call test02
    
   
    
    
    Application.ScreenUpdating = True
    Exit Sub
    
myError:
    MsgBox Err.Description
    erfilecount = erfilecount + 1
    Application.ScreenUpdating = True
End Sub

 'Sheet2での退職者区分け
 
      
      Sub test02()
      

    
         Dim wb1 As Workbook
         Dim i As Long
         Dim s As Long
         Dim mo As String
         Dim td As String
         Dim FileName_InFolder As String
         Dim LastRow As Long
         
         Dim strYYYYMMDD As String
  
         'Now関数で取得した現在日付をFormatで整形して変数に格納
         
         strYYYYMMDD = Format(Now, "yyyymmdd")
         
         '最終行の取得
         
         LastRow = ThisWorkbook.Worksheets(2).Cells(Rows.Count, "B").End(xlUp).Row + 1
         
         i = 2
         
         td = ThisWorkbook.Worksheets(2).Cells(i, "K")
         
        Do Until i = LastRow
         
         mo = ThisWorkbook.Worksheets(2).Cells(i, "A")
         
         If ThisWorkbook.Worksheets(2).Cells(i, "H") <> "" Then
         
         
            ThisWorkbook.Worksheets(2).Cells(i, "C") = td
         
            ThisWorkbook.Worksheets(2).Cells(i, "B") = mo & "退職"
         
         End If
         
            i = i + 1
         
        Loop
          
          'ヘッダーの削除
          
          ThisWorkbook.Worksheets(2).Rows(1).Delete
          
        'CSVで別ファイル保存
        Set wb1 = ThisWorkbook
          
         mo = strYYYYMMDD
         Workbooks.Add.SaveAs Filename:=mo, FileFormat:=xlCSV
         wb1.Worksheets(2).Copy After:=Workbooks(mo & ".csv").Worksheets(1)
         Workbooks(mo & ".csv").Save
         Workbooks(mo & ".csv").Saved = True
         Workbooks(mo & ".csv").Close
         
        
      End Sub

毎回未熟な質問で申し訳ありません。
皆様のお力をお貸しください。
Excelは2013を使用しております。

Answer 1

私も細かいアルゴリズムまでは理解していませんが、エクセルは一度入力があった箇所は消しても認識している場合があります。
ですので、見た目上は10行しかなくても、エクセル的には最終行は13行目として認識しているというケースはたまに起こります。

ですので、入力の形式が決まっているのであれば、それに該当しない行は処理しないとかすれば解決すると思います。例えば、１列目が空白なら処理しないみたいな

それ以外のちゃんとしたやり方は下記を参考にしてみてください。
ExcelVBAで最終行を誤認する問題の回避方法

Answer 2

ども。。。

シート上の意図するデータ範囲と、
罫線や数式、あるいはセルの書式設定が設定されているセル範囲とが
同じなのかどうなのかわかりませんが、
（不要な行は削除しておいた方がよいでしょう。）
とりあえず、セル範囲が意図しないセル範囲として認識されるようなら、
セルの編集後（特にセル範囲の削除をした場合）、
つまり提示のコードで言うと、

'ヘッダーの削除
ThisWorkbook.Worksheets(2).Rows(1).Delete

の後に、

Thisworkbook.Worksheets(2).UsedRange

と、呪文を唱えてみてはいかがでしょうか？

それで上手くいくなら、

'Sheet2での退職者区分け
Sub test03()
    Dim wshTarget As Worksheet  '操作対象シート
    Dim rngTarget As Range      '操作対象セル範囲
    Dim r As Range              '各行
    Dim mo As String            '日付？
    Dim td As String            '各人のID?
        
    Set wshTarget = ThisWorkbook.Worksheets("Sheet2")
    wshTarget.Rows(1).Delete
        Set rngTarget = wshTarget.UsedRange
    td = rngTarget.Range("K1").Value
    
    '行毎に見て処理をする
    For Each r In rngTarget.Rows
        With r
            mo = .Range("A1").Value
            If IsEmpty(.Range("H1").Value) = False Then
                .Range("C1").Value = td
                .Range("B1").Value = mo & "退職"
            End If
        End With
    Next
    
    '対象シートをCSV形式で保存
    wshTarget.Copy
    With Workbooks
        With .Item(.Count)
            .SaveAs Filename:=mo, FileFormat:=xlCSV
            .Close False
        End With
    End With
End Sub

また、
数式で処理できる作業のようなので、
列毎に数式を「一括」で入力することで、
VBAで繰り返しの処理を書かないようにすると、
処理速度の高速化が望めそうです。
（データ数が少なければ体感は変わらないかも知れませんが。）

もし、このコードで期待通りの結果が得られたなら、
「できた」で終わらずに、
個々の単語、個々の行を精査して、
意味が分からない、ところはどんどん質問して、
理解を深めていただけると幸いです。

そちらの理解度がどの程度かわからないので、
いちいち1から10まで解説するのは省略します。

最後に、
空白行を入れるのは、
それぞれの作業の分けの部分に入れる程度にした方が読みやすいです。
1画面に1つのプロシージャが入りきらないと、
スクロールを強いられ、作業性が悪くなると思います。
（読んでいて、コードが長くなる。あるいは変数の登場数が多くなる場合は、
プローシージャを分けるといいと思いました。）

あ、追記
あと、
「空白に見えるが空白でないセル」が存在する可能性があります。
そういったセルがあるなら、
置換機能や数式を利用して内容をクリアする必要があるかもしれません。
対象セル範囲を選択しジャンプ機能で空白セルを検索し、
間違いがないか確認してみてください。

Answer 3

'+1はインデックスを考慮した場合、インデックスがないのなら不要です
LastRow = ThisWorkbook.Worksheets(4).Cells(Rows.Count, "B").End(xlUp).Row + 1

ここで最終行を取得していますが、そこで更に一行足していますね。おそらく、元の手本にした数式は先頭の見出し（インデックス行）も含めて表示していたのではないでしょうか（+1というのはインデックス行も足しているためです）。先頭行から値が入っているのなら、+1は不要なので消してください。

,,,,というのは値の入っている最終行の次の行を見に行っている証拠です。

Answer 4

検証したところ、最初の私の回答が間違いであることを確認いたしました。
大変申し訳ございませんでした。

混乱防止のため、消去したしました。