VBA マクロでの転記の実装

以下の「現状のソース」を実行すると、[現状の実行結果]のようになり、「月」が正しく転記されません。

そこで、以下の「実装内容」で新たにコードを修正しようと思うのですが、コードの書き方がわからずに困っています。。。
どのようにソースを書けば良いでしょうか、ご教授いただけると幸いです。

実装内容

C列が３でセル結合しているとき.MergeCellsがTrueの時に.MergeArea.Count = 3のとき
C列に「担当者」という文字列が入っているとき、「年月」の値をコピー先の行へ設定する。

C列が2でセル結合しているとき.MergeCellsがTrueの時に.MergeArea.Count = 2のとき
C列に文字列が入っているとき、[担当者][工数]の値をコピー先の行へ設定する。

[現状のソース]

Macro
1Sub sample1()
2
3    Dim lngRowsNo As Long                        ' 書きこむ位置(行)
4    Dim lngSheetIndex   As Long                     ' シートの番号
5    Dim strFile         As String                   ' Excelファイルの場所
6    Dim xlsAcq          As New Excel.Application    ' 取得側Excel
7    Dim wbAcq           As Workbook                 ' 取得側Excelブック
8    Dim wsAcq           As Worksheet                ' 取得側Excelシート
9    Dim wsSet           As Worksheet                ' 設定側Excelシート
10    Const strPath       As String = "/Users/keiichi/Desktop/マクロ宿題/"
11    Set wsSet = ActiveSheet
12    Dim i As Long
13
14    strFile = Dir(strPath & "*.xls")
15    lngRowsNo = 3  ' 書きこみ開始位置(行)
16    Do Until strFile = ""
17        '----- Excelブックを開く
18        Set wbAcq = Workbooks.Open(strPath & strFile)
19
20        '----- シートを検索
21        For lngSheetIndex = 1 To wbAcq.Worksheets.Count
22            '----- 「更新」シートを検索
23            If wbAcq.Worksheets(lngSheetIndex).Name = "最新" Then
24                '----- 「更新」シートを変数へ登録
25                
26                Set wsAcq = wbAcq.Worksheets(lngSheetIndex)
27                '----- 「更新」シートの内容を現在のシートにコピー(自由に変更して下さい)
28                With wsAcq
29                Dim fname As String        'ファイル名
30                Dim n As Long                  'ループで使用します。
31                Dim m As Long                  'ループで使用します。
32                Dim ec1 As Long               '各開発の一番下の担当者のセルを取得
33                Dim ec2 As Long               '各開発の 月の一番右（最後）のセルを取得
34                Dim ec3 As Long               '月数を取得
35                Dim ColumnNo As Long    ' 転記先の列番号（初期値４）
36                Dim ColumnNo2 As Long    ' 転記元の列番号（初期値５）＋３されていく
37                
38                ColumnNo = 4
39                ColumnNo2 = 5
40
41                For i = 1 To .UsedRange.Rows.Count
42
43                  If (Left(.Cells(i, 2).Value, 2) = "A1" Or Left(.Cells(i, 2).Value, 2) = "B1" Or Left(.Cells(i, 2).Value, 2) = "C1") And .Cells(i, 2).MergeCells = False Then
44                    
45                    '月を取得して転記
46                    ec2 = .Cells(i + 1, 5).End(xlToRight).Column + 1
47                    
48                    For col = 5 To ec2
49                    
50                    '「担当者」の転記
51                        wsSet.Cells(lngRowsNo - 1, 3).Value = .Cells(i + 1, 3).Value
52                        
53                    '「担当者」以降の 「月」の転記
54                        wsSet.Cells(lngRowsNo - 1, ColumnNo).Value = .Cells(i + 1, ColumnNo2).Value
55                        
56                        ColumnNo = ColumnNo + 1
57                        ColumnNo2 = ColumnNo2 + 3
58
59                    Next col
60                    
61                    ' ------ 開発〇から一番上の担当者のセル位置を相対的にCells(i + 3, 3)として取得し
62                     'データの入っているところまでループさせる (その時、開発名を転記)
63                     ec1 = .Cells(i + 3, 2).End(xlDown).Row
64                        For n = i + 3 To ec1
65                        
66                        '担当者が空白の時スキップする
67                        If Cells(n, 3) = "" Then
68                        GoTo NEXT99
69                        End If
70                        
71                            'ファイル名
72                            fname = ActiveWorkbook.Name
73                            wsSet.Cells(lngRowsNo, 1).Value = fname
74                            If .MergeArea.Count = 4 Then
75                            End If
76                            'メソッドまたはデータメンバーが見つかりません
77                            '開発
78                            wsSet.Cells(lngRowsNo, 2).Value = .Cells(i, 2).Value
79                            
80                             '担当者
81                            wsSet.Cells(lngRowsNo, 3).Value = .Cells(n, 3).Value
82                            
83                             '工数
84                            wsSet.Cells(lngRowsNo, 4).Value = .Cells(n, 5).Value
85                            
86                            wsSet.Cells(lngRowsNo, 5).Value = .Cells(n, 8).Value
87                            
88                            wsSet.Cells(lngRowsNo, 6).Value = .Cells(n, 11).Value
89                            
90                            wsSet.Cells(lngRowsNo, 7).Value = .Cells(n, 14).Value
91                            
92                            wsSet.Cells(lngRowsNo, 8).Value = .Cells(n, 17).Value
93                            
94                            wsSet.Cells(lngRowsNo, 9).Value = .Cells(n, 20).Value
95                            
96                            wsSet.Cells(lngRowsNo, 10).Value = .Cells(n, 23).Value
97                            
98                            wsSet.Cells(lngRowsNo, 11).Value = .Cells(n, 26).Value
99                            
100                            wsSet.Cells(lngRowsNo, 12).Value = .Cells(n, 29).Value
101                            
102                            wsSet.Cells(lngRowsNo, 13).Value = .Cells(n, 32).Value
103                            
104                             '１行下へ
105                            lngRowsNo = lngRowsNo + 1
106                            
107NEXT99:
108                        Next n
109                        
110                    End If
111                Next i
112                End With
113               
114                '----- 検索の終了
115                Exit For
116            End If
117        Next lngSheetIndex
118
119        '----- シート参照の解放
120        Set wsAcq = Nothing
121        '----- ブックを閉じる
122        wbAcq.Close Savechanges:=False
123        
124        '----- 次のファイルへ
125        strFile = Dir()
126        
127        
128    Loop
129
130    '----- Excelへの参照の解放
131    Set xlsAcq = Nothing
132    
133    Dim maxrow As Long  '最終行
134    maxrow = wsSet.Cells(Rows.Count, 3).End(xlUp).Row 'C列で最終行を求める
135    For i = 3 To maxrow
136    
137        If wsSet.Cells(i, "C").Value = "担当者" Then
138            wsSet.Cells(i, "A").Value = ""
139            wsSet.Cells(i, "B").Value = ""
140        End If
141    Next
142
143End Sub
144

質問２.xls

質問３.xls

[現状の実行結果]

[実装したい実行結果]

coco_bauer

2020/09/27 01:32

実装内容とエラーメッセージには、「.MergeArea.Count」という文字列が含まれていますが、現状のソースには含まれていません。なので、現状のソースをコンパイルしても質問に書かれているようなエラーメッセージが出るとは思えません。何か、取り違えをしてらっしゃいませんか？

icecleam

2020/09/27 03:33

すみません If .MergeArea.Count = 3 Then End If という１文を「現状のソース」に記載しているときに、エラーメッセージ「メソッドまたはデータメンバーが見つかりません」が出てしまいます。質問する際にコンパイルエラーの含まれるコードを載せるのはどうかと思い、その一文は含まない形で掲載させていただきました。すみません、確かにこの書き方だと伝わりづらいですね、、

質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう！

実装内容

実現したいこと

困っている事

現在まで完成しているコード

関連した質問