【VBA】複数ページへの転記

実現したいこと

ws2やws3から条件にあてはまる行をws1に転記したいのですが
ws1には35行分しか記載できません。(15~50行目)
35行を超える分はページを複製し転記するか、あらかじめ用意したシートに転記したいです。

あらかじめ用意したシート
Set ws4 = wb1.Sheets("ws4")
2行目=項目行
3行目から転記開始

発生している問題・分からないこと

ws2からws1への転記条件(AP列=”●”)をカウントし、35以上か35以下で処理をわけようと思ったのですがどうもうまくできません。。

該当のソースコード

VBA

1Sub 正方形長方形2_Click() 2 3 Dim wb1 As Workbook, wb2 As Workbook, wb3 As Workbook 4 Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet 5 6 Set wb1 = Workbooks.Open("*****") 7 Set wb2 = Workbooks.Open("*****") 8 Set wb3 = Workbooks.Open("*****") 9 10 Set ws1 = wb1.Sheets("ws1") 11 Set ws2 = wb2.Sheets("ws2") 12 Set ws3 = wb3.Sheets("ws3") 13 14 ' フィルター解除&背景色クリア 15 ws3.AutoFilterMode = False 16 ws3.Cells.Interior.ColorIndex = xlNone 17 18 ' 転記 19 Dim lastRow_ws2 As Long 20 Dim lastRow_ws3 As Long 21 Dim i As Long 22 Dim j As Long 23 Dim k As Long 24 25 lastRow_ws2 = ws2.Cells(ws2.Rows.Count, "AP").End(xlUp).Row 26 lastRow_ws3 = ws3.Cells(ws3.Rows.Count, "C").End(xlUp).Row 27 28 ' 15行目から50行目までを空欄にする 29 ws1.Rows("15:50").ClearContents 30 31 j = 15 ' wb1の行番号 32 k = 15 ' ws1の行番号 33 34 ' ws2からws1へ転記 35 For i = 2 To lastRow_ws2 36 If ws2.Cells(i, "AP").Value = "●" Then 37 ws1.Cells(j, "B").Value = "'" & ws2.Cells(i, "AQ").Value 38 ws1.Cells(j, "C").Value = ws2.Cells(i, "BL").Value 39 ws1.Cells(j, "D").Value = ws2.Cells(i, "BP").Value 40 ws1.Cells(j, "E").Value = ws2.Cells(i, "B").Value 41 ws1.Cells(j, "F").Value = "'" & ws1.Cells(10, "P").Value & "月分" 42 ws1.Cells(j, "G").Value = ws2.Cells(i, "AE").Value 43 44 'ws3からws1へ転記 45 For l = 2 To lastRow_ws3 46 If ws1.Cells(j, "C").Value = ws3.Cells(l, "C").Value Then 47 ws1.Cells(k, "H").Value = ws3.Cells(l, "F").Value 48 ws1.Cells(k, "I").Value = ws3.Cells(l, "H").Value 49 ws1.Cells(k, "J").Value = ws3.Cells(l, "I").Value 50 ws1.Cells(k, "K").Value = ws3.Cells(l, "J").Value 51 ws1.Cells(k, "L").Value = ws3.Cells(l, "L").Value 52 k = k + 1 53 54 ' ws3のC列に色を設定 55 ws3.Cells(l, "C").Interior.Color = RGB(198, 224, 180) 56 57 Exit For 58 End If 59 Next l 60 61 j = j + 1 62 End If 63 Next i 64 65 66 ' メッセージボックスを表示 67 MsgBox "処理が完了しました。", vbInformation 68 69End Sub 70 71

試したこと・調べたこと

上記の詳細・結果

そもそもAP=”●”のカウントがうまくできなかった。

【1】
countAP = Application.WorksheetFunction.CountIf(ws2.Range("AP:AP", "●"))

【2】
countAP = 0
For i = 2 To lastRow_ws2
If ws2.Cells(i, "AP").Value = "●" Then
countAP = countAP + 1
End If
Next i

補足

特になし

コメントを投稿

0 コメント