| 
    
     |  | ▼ケイ さん: 
 PasteSpecial版のコードをアップいただいたあと、意見を申し上げようと
 思いましたが、これから、ちょっと野暮用がありますので、
 
 ・まず、Copyメソッドの、その行に、さらにPasteSpecialメソッドを記述するという
 器用なことはVBAではできません。
 やるなら、Copyのみ(Destinationなし)、そのあと、あらためてPasteSpecialを
 実行。
 ・Range("B6").CurrentRegion.Rows.Count が気になります。
 シート上に、(とくにB列の5行目以前に)どのようにデータがあるかがわからないのですが、
 かりにデータがB7までしかなく、かつ、B5以前が空白だと、ここで取得する行数は
 2 になります。そうしますと、ループで 6 To 2 ということで、処理されずに
 おわってしまいますね。
 ・値の転記であれば、もちろんPasteSpecialでもいいのですが、「普通に」セルのValueを
 転記するコードが素直でいいのでは?
 ・また、必要行数(個数)のコピーですが、ループで行わずとも、一発でセットできます。
 (通常の転記でもPasteSpecialでも)
 
 といったことを加味しますと、たとえば以下。
 
 Sub Sample()
 Dim コピー先行 As Long
 Dim コピー元行 As Long
 Dim 下端行 As Long
 Dim 個数 As Long
 Dim maxR As Long
 
 Application.ScreenUpdating = False
 maxR = Rows.Count
 With Sheets("AAA")
 コピー先行 = 7
 Sheets("BBB").Range("L7:L" & maxR).ClearContents
 下端行 = .Range("B" & maxR).End(xlUp).Row
 If 下端行 < 6 Then
 MsgBox "データがありません"
 Else
 For コピー元行 = 6 To 下端行
 個数 = Val(.Cells(コピー元行, 58).Value)
 If 個数 > 0 Then
 Sheets("BBB").Cells(コピー先行, "L").Resize(個数).Value = _
 .Cells(コピー元行, "B").Value
 コピー先行 = コピー先行 + 個数
 End If
 Next
 End If
 End With
 Application.ScreenUpdating = True
 End Sub
 
 
 
 |  |