VBA コピーで書式が一部変わる

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

book1からbook2へ転記するコードを書いているのですが、
書式が変わる行が一部あり困っています。

添付の写真のように9～18行目のみ書式が変わります。
確認としては
・book1の書式設定は正しい
・コピー前のbook2の書式設定も正しい
・条件付き書式は未設定

正しい書式は19行目以降です。

どのような操作をすればすべて正しい書式にすることが出来るのでしょうか。

ご助言いただければ幸いです。

宜しくお願いいたします。

VBA
1Sub test()
2Application.ScreenUpdating = False
3Application.Calculation = xlCalculationManual
4
5'定義枠-------------------------------------------------------------------------------------------
6    
7    Dim i As Long, x As Long, z As Long, g As Long
8    
9    Dim ws As Worksheet
10    Dim 業者名 As String, 業者 As String
11    
12    Dim wb As Workbook, motowb As Workbook
13    Set wb = ThisWorkbook
14    
15    Dim ws1 As Object, ws2 As Object
16    Set ws1 = wb.Worksheets(1)
17    Set ws2 = wb.Worksheets(2)
18    
19    Dim mrow As Integer, row1 As Integer, row2 As Integer, frow As Long, grow As Long, xrow As Long
20    
21    Dim flg As Boolean
22    
23  '-----------------------------------------------------------------------------------------------
24    
25   '業社シートクリア
26    For x = 4 To Worksheets.Count
27        xrow = wb.Worksheets(x).Cells(Rows.Count, 1).End(xlUp).row
28        wb.Worksheets(x).Range(wb.Worksheets(x).Cells(9, 1), wb.Worksheets(x).Cells(xrow + 10, 13)).ClearContents '+10は保険
29    Next x
30    
31    
32   '揚重実績値クリア
33    frow = wb.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).row
34    ws1.Range(ws1.Cells(9, 1), ws1.Cells(frow + 10, 13)).ClearContents
35     
36     
37    '加工前データ呼び出し
38    Workbooks.Open wb.Path & "\加工前データ.xlsx"
39    Set motowb = ActiveWorkbook
40
41
42    '揚重実績シート入力
43    mrow = motowb.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).row
44    ws1.Range(ws1.Cells(9, 1), ws1.Cells(mrow, 12)).Value = motowb.Worksheets(1).Range(motowb.Worksheets(1).Cells(9, 1), motowb.Worksheets(1).Cells(mrow, 13)).Value
45    With ws1.Range(ws1.Cells(9, 1), ws1.Cells(mrow + 3, 13))
46        .RowHeight = 23.25
47        .Borders.LineStyle = True
48    End With
49            
50    With ws1.Cells(mrow + 3, 9)
51        .Value = "回数"
52        .Offset(0, 1).Formula = "=SUM(J9:J" & (mrow) & " )"
53        .Offset(0, 2).Formula = "合計"
54        .Offset(0, 3).Formula = "=SUM(L9:L" & (mrow) & " )"
55    End With
56    
57    
58    '業者シート振り分け
59    For i = 9 To mrow
60    業者名 = ws1.Cells(i, 5)
61    
62        flg = False
63        For Each ws In wb.Worksheets
64            If ws.name = 業者名 Then
65              flg = True
66            End If
67            Next ws
68    
69    If flg = True Then
70        On Error GoTo myError
71            wb.Worksheets(業者名).Activate
72            Set ws = wb.Worksheets(業者名)
73            row1 = ws.Cells(Rows.Count, 1).End(xlUp).row
74            ws.Range(ws.Cells(row1 + 1, 1), ws.Cells(row1 + 1, 12)).Value = ws1.Range(ws1.Cells(i, 1), ws1.Cells(i, 12)).Value
75    
76    Else
77
78myError:
79            wb.Sheets("業者").Copy After:=wb.Sheets(wb.Worksheets.Count)
80            ActiveSheet.name = 業者名
81            Set ws = Worksheets(業者名)
82            row2 = ws.Cells(Rows.Count, 1).End(xlUp).row
83            ws.Range("F4").Value = 業者名
84            ws.Range(ws.Cells(row2 + 1, 1), ws.Cells(row2 + 1, 12)).Value = ws1.Range(ws1.Cells(i, 1), ws1.Cells(i, 12)).Value
85           
86End If
87    Next
88    
89    '各業者シート体裁
90    For g = 4 To Worksheets.Count
91            grow = wb.Worksheets(g).Cells(Rows.Count, 1).End(xlUp).row
92            With wb.Worksheets(g).Cells(grow + 1, 9)
93                .Value = "回数"
94                .Offset(0, 1).Formula = "=SUM(J9:J" & (grow) & " )"
95                .Offset(0, 2).Formula = "合計"
96                .Offset(0, 3).Formula = "=SUM(L9:L" & (grow) & " )"
97            End With
98            
99            With Worksheets(g).Range(Worksheets(g).Cells(9, 1), Worksheets(g).Cells(grow + 1, 13))
100                .RowHeight = 23.25
101                .Borders.LineStyle = True
102            End With
103            
104    Next
105ws1.Activate
106
107Application.ScreenUpdating = True
108Application.Calculation = xlCalculationAutomatic
109    
110End Sub
111

tatsu99

2020/10/19 08:22

提示されているシートのシートどれでしょうか？揚重実績シート、業者、業者シートのどれでしょうか？

SSS_

2020/10/19 08:25

book1⇒book2の揚重実績シートとするのですが、正しく表示されないのは揚重実績シートです。 1行ずつ実行すると、実行している傍から書式が勝手に変更されていきます。

tatsu99

2020/10/19 08:31

それは、ソースのどの行ですか？

SSS_

2020/10/19 08:33

以下の★がついている行です。 '揚重実績シート入力 mrow = motowb.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).row ★ws1.Range(ws1.Cells(9, 1), ws1.Cells(mrow, 12)).Value = motowb.Worksheets(1).Range(motowb.Worksheets(1).Cells(9, 1), motowb.Worksheets(1).Cells(mrow, 13)).Value

SSS_

2020/10/19 08:36

ちなみになのですが、このbook内では揚重実績シート⇒業者シート⇒表紙とこの先転記していくのですが揚重実績シート⇒業者シート：こちらの転記では崩れたデータ(この質問の内容です)も正しく直されて転記されます。業者シート⇒表紙：正しかったデータがまた崩れて転記されます。と謎です。

tatsu99

2020/10/19 08:37

ありがとうございます。その個所をこちらでも、確認してみます。

tatsu99

2020/10/19 08:54

こちらで、実行させましたところ再現しませんでした。（データの全行、同じ書式です）揚重実績シートの9行目以降から最後（罫線の最後の行）まで、一旦、手動で削除してから、実行するとどうなりますでしょうか。

SSS_

2020/10/19 08:58

大変ご親切にありがとうございます。いったん削除後、書式を正しく再設定し直しましたが同様の現象が起きます。 tatsu99様では再現されないとのことですが、私のエクセル自体の設定がおかしいのでしょうか。