エクセル 転記ループが上手くいきません
ToDoファイルに記載した内容を別ファイルの管理シートに転記したいと考えています。
ToDoの4列目、管理シートの1列目に共通の管理IDを持たせてそこで紐づけさせ、ToDoの11列目に記載した内容を管理シートの72列目、ToDoの22列目に記載した内容を管理シートの73列目・・・といういう形で転記していきたいです。
以下のように作ってみたのですが、これでは転記されず、ここにもう一つループを加えると転記されるようになります。
(今は For i = 1 To last1 と For ii = 1 To last2の二つのループですが、もう一つ For j = 1 To last2 とかを加えると転記されます。)
なぜなのか分かりません。
どなかた理由と解決方法を教えていただけないでしょうか?
どうぞよろしくお願いいたします。
Sub 管理シートへ貼り付け()
Dim BookA As Workbook
Dim BookB As Workbook
Dim last1 As Long
Dim last2 As Long
Dim i As Long
Dim ii As Long
Workbooks.Open Filename:="管理シート.xlsm"
Windows("ToDo.xlsm").Activate
Set BookA = Workbooks("ToDo.xlsm")
Set BookB = Workbooks("管理シート.xlsm")
last1 = BookA.Sheets("ToDo").Cells(Rows.Count, 1).End(xlUp).Row
last2 = BookB.Sheets("管理シート").Cells(Rows.Count, 1).End(xlUp).Row
With BookA.Sheets("ToDo")
For i = 1 To last1
For ii = 1 To last2
If .Cells(i, 4) = BookB.Sheets("管理シート").Cells(ii, 1) Then
BookB.Sheets("管理シート").Cells(ii, 72) = .Cells(i, 11)
BookB.Sheets("管理シート").Cells(ii, 73) = .Cells(i, 22)
BookB.Sheets("管理シート").Cells(ii, 74) = .Cells(i, 23)
BookB.Sheets("管理シート").Cells(ii, 75) = .Cells(i, 24)
BookB.Sheets("管理シート").Cells(ii, 76) = .Cells(i, 25)
End If
If .Cells(i, 1).Value = "貼付け後削除" Then
Rows(i).Hidden = True
End If
Exit For
Next
Next
End With
MsgBox "転記が終わりました"
End Sub