| |
▼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メソッドを記述するという
> 器用なことはＶＢＡではできません。
> やるなら、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
>
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
- 11/1/24(月) 16:35 -
