Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


14230 / 76734 ←次へ | 前へ→

【68003】Re:別シートへ値で貼り付ける方法
お礼  ケイ E-MAIL  - 11/1/24(月) 18:27 -

引用なし
パスワード
   ▼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
>

4 hits

【67998】別シートへ値で貼り付ける方法 ケイ 11/1/24(月) 16:35 質問
【68000】Re:別シートへ値で貼り付ける方法 UO3 11/1/24(月) 17:07 発言
【68002】Re:別シートへ値で貼り付ける方法 UO3 11/1/24(月) 18:13 回答
【68003】Re:別シートへ値で貼り付ける方法 ケイ 11/1/24(月) 18:27 お礼
【68004】Re:別シートへ値で貼り付ける方法 UO3 11/1/25(火) 9:20 回答
【68016】Re:別シートへ値で貼り付ける方法 ケイ 11/1/25(火) 14:41 お礼

14230 / 76734 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free