請求書作成①

Sub Uriage_Keisan()
Dim Tenmei  As String   '作成する店名　文字列
Dim i As Long                '売上データの行数
Dim j As Long                '作成する売上表の行数
Dim k As Long               '売上の項目の位置(列)
Dim SaisyuGyo As Long  '売上データの最終行

'Application.ScreenUpdating = False  '画面の更新を止める
                                     'ちらつき防止

Call Sheet_Clear                               '全店名別シートのClear

With Worksheets("売上明細")

    SaisyuGyo = .Cells(Rows.Count, 3).End(xlUp).Row
    
    For i = 3 To SaisyuGyo
        Tenmei = .Cells(i, 3)
                 
                '売上表に転記
                Worksheets(Tenmei).Activate
                j = Cells(Rows.Count, 2).End(xlUp).Row
                For k = 4 To 7
                    Cells(j + 1, k - 2) = .Cells(i, k)   '商品名～金額
                Next k
                
    Next i
        
End With

Worksheets("売上明細").Activate

'Application.ScreenUpdating = True  '画面の更新を再開する

End Sub

Sub Sheet_Clear()　　　　'全店名別シートのClear

Dim Tenmei  As String   '作成する店名　文字列
Dim Tenmei_No As Long   '店名一覧の行数

    For Tenmei_No = 3 To 7
    
        Tenmei = Worksheets("店名一覧").Cells(Tenmei_No, 2)
        With Worksheets(Tenmei)
        
            '5行目以降をすべて消去
            .Rows("5:" & Rows.Count).ClearContents
            '5行目以降最終行まで消去するなら
'           .Rows("5:" & .Cells(Rows.Count, 3).End(xlUp).Row) _
'           .ClearContents
           
        End With
    Next Tenmei_No
    
End Sub

'売上明細→同ブック全会社請求書
Sub Seikyusyo_Sakusei0()

    Dim Kaisyamei  As String   '請求先会社名
    Dim i As Long              '売上データの行数
    Dim j As Long              '作成する売上表の行数
    Dim k As Long              '売上の項目の位置(列)
    Dim SaisyuGyo As Long      '売上データの最終行
    
    Dim WS As Worksheet
    
    'Application.ScreenUpdating = False  '画面の更新を止める　ちらつき防止
      
'*****************************
     '請求書作成
'*****************************
    Call Sheet_Clear                                    '全請求書シートの明細消去
    
    With ThisWorkbook.Worksheets("売上明細")
    
        SaisyuGyo = .Cells(Rows.Count, 3).End(xlUp).Row  '明細最終行
        
        For i = 3 To SaisyuGyo
            Kaisyamei = .Cells(i, 3)
            
        '*****************************
　　　　'この部分を加える　↓

         '会社名の請求書シートがあるかどうか？
            On Error Resume Next                    'エラーがあっても次に進む
            Set WS = Worksheets(Kaisyamei)
            
            If WS Is Nothing Then                      'シートなければ、作成する

                Worksheets("請求書ひな形").Copy after:=Worksheets(Worksheets.Count)
                Worksheets(Worksheets.Count).Name = Kaisyamei
                
                Call KaisyaJyouhou(Kaisyamei)           '会社情報転記（請求書Header）
            
            Else
                Worksheets(Kaisyamei).Activate 　　　　 'シートあれば、アクティブに
                Set WS = Nothing                       'オブジェクト変数をクリア
            End If
            On Error GoTo 0                            'エラー処理を戻す

　　　　'　ここまで　↑
        '*****************************
        
            '請求書に転記
            j = Cells(29, 2).End(xlUp).Row   '請求書最終行
            For k = 4 To 6
                Cells(j + 1, k - 2) = .Cells(i, k)   '最終行+1へ追加
            Next k
                
        Next i
        
    End With

    'Application.ScreenUpdating = True  '画面の更新を再開する

End Sub

Sub Sheet_Clear()
    
       Dim SaisyuGyo As Long, Gyo As Long, i As Long
       Dim Kaisyamei As String
       Dim WS As Worksheet
       Dim KM As Worksheet
    
       Set KM = Worksheets("顧客マスター")
       
       '顧客マスター最終行
       SaisyuGyo = KM.Cells(Rows.Count, 2).End(xlUp).Row
        
        '顧客マスター最終行までループ
       For i = 3 To SaisyuGyo
       
           Kaisyamei = KM.Cells(i, 2)
           
           On Error Resume Next  　　　   'エラーがあっても次に進む
           Set WS = Worksheets(Kaisyamei)
           On Error GoTo 0         　     'エラー処理を戻す
           
           'シートがあるかないか判断
           If Not (WS Is Nothing) Then
           
                'ワークシートがあればアクティブに
               Worksheets(Kaisyamei).Activate
               
                '取り出すシートの最終行
               Gyo = Cells(29, 2).End(xlUp).Row
           
               'データがある場合のみ、Clearする
               If Gyo >= 16 Then
                    '16行目から最終行まで表の範囲を消去
                   Range(Cells(16, 1), Cells(Gyo, 4)).ClearContents
               End If
               Set WS = Nothing
           End If
           
       Next i
        
End Sub
Sub KaisyaJyouhou(Kaisyamei As String)
     Dim i As Long, SaisyuGyo As Long
     Dim KM As Worksheet
     
     Set KM = Worksheets("顧客マスター")
     SaisyuGyo = KM.Cells(Rows.Count, 3).End(xlUp).Row  '顧客マスター最終行
     
     '会社情報転記
     For i = 3 To SaisyuGyo
        If Kaisyamei = KM.Cells(i, 2) Then
           Range("a2") = Kaisyamei
           Range("a3") = "〒" & KM.Cells(i, 3)     '〒
           Range("a4") = KM.Cells(i, 4)            '住所
           Range("a5") = "TEL：" & KM.Cells(i, 5)  '電話番号
           Exit For
         End If
     Next i
     
End Sub