|
▼UO3 さん:
ご返信ありがとうございます。
あの後
Sub 回数分コピー()
Worksheets("AAA").Activate 下端行 = Range("B6").CurrentRegion.Rows.Count 'アクティブセル領域の行数を取得する
コピー元行 = 6
コピー先行 = 7
Dim a As Long
Dim b As Long
b = 7
For a = 6 To 下端行
個数 = Cells(a, 58).Value '個数を取得する
For 回数 = 1 To 個数
コピー元セル = Range(Cells(a, 2), Cells(a, 3))
コピー先セル = Cells(b, 12)
Worksheets("AAA").Range(Cells(a, 2), Cells(a, 3)).Copy _
Destination:=Worksheets("BBB").Cells(b, 12)
b = b + 1
Next
Next a
End Sub
というように書き換えてみました。
コピー元はB:C列で、貼り付け先はBBBシートのL:M列です。
送っていただきましたコードを参考にさせていただきます。
ご親切にありがとうございました。
>▼ケイ さん:
>
>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
>
|
|