【ＶＢＡ】別のシートへ情報をコピーしたい

VBA経験浅いため、初歩的なミスがあるかもしれません。
宜しくお願いします。

【状況】
案件ごとに品目数が異なります。
各品目に複数（5個）の情報が繋がっています。
この複数の情報を別シートの1行に並べていきたいです。

【条件】
①品目数は『Kcnt』個としております。
②品目数が『0』個の時は処理しません。
③品目数が『41』個以上の時は処理しません。
④品目数が『1』個～『40』個の時、別シートへのコピーを実行

以下、自分なりに作ってみたのですが、
条件④の処理が実行されていないと思われます。
ご指摘くださると助かります。

宜しくお願いします。


【作成したコード】
Option Explicit

Dim kari As Worksheet
Dim DB As Worksheet
Dim Kcnt, cnt, i, m, n As Integer


'品目数の抽出
Sub FKaden()
Set kari = Worksheets("sheet1")
Set DB = Worksheets("sheet2")


cnt = WorksheetFunction.CountA(Range("F7:F46"))
kari.Range("A5") = cnt

End Sub

'条件ごとにの処理（別シートへのコピー）
Sub FKaden2()

Set kari = Sheets("sheet1")
Set DB = Sheets("sheet2")
i = 1

Kcnt = kari.Range("A5").Value

If Kcnt = 0 Then

MsgBox "回収対象がありません。"

ElseIf Kcnt <= 40 Then
Do
m = 1 + i
n = 4 + i

DB.Cells(m, 4).Value = kari.Cells(6, n).Value
DB.Cells(m, 4).Value = kari.Cells(10, n).Value
DB.Cells(m, 4).Value = kari.Cells(14, n).Value
DB.Cells(m, 4).Value = kari.Cells(22, n).Value
DB.Cells(m, 4).Value = kari.Cells(30, n).Value

i = i + 1

Loop Until i > Kcnt

ElseIf Kcnt > 40 Then

MsgBox "品目数は40品目までです。"

End If


End Sub

【コード終わり】

以上です。
無駄な点や、根本的に考え方が違う場合にも
バッサリご指摘お願いします。
宜しくお願いします。

質問者からの補足コメント

• 【修正】2016/1/20 22:06
  Do
  m1 = 1 + i
  ｍ2 = 2 + i
  m3 = 3 + i
  m4 = 4 + i
  m5 = 5 + i
  n = 4 + i
  
  DB.Cells(m1, 4).Value = kari.Cells(6, n).Value
  DB.Cells(m2, 4).Value = kari.Cells(10, n).Value
  DB.Cells(m3, 4).Value = kari.Cells(14, n).Value
  DB.Cells(m4, 4).Value = kari.Cells(22, n).Value
  DB.Cells(m5, 4).Value = kari.Cells(30, n).Value

    補足日時：2016/01/20 22:08

• お陰さまで解決しました。
  単純に、対応するセルの選択が間違っていたようです。
  
  お騒がせしました！！

    補足日時：2016/01/21 00:02

No.1 ベストアンサー 回答者： Hypnomatic 回答日時： 2016/01/20 21:42

まず、何がどういう状態でセルに入っているのかがわからない。

そして、コードだけ見て見るならば

１：DB.Cells(m, 4).Value = kari.Cells(6, n).Value
２：DB.Cells(m, 4).Value = kari.Cells(10, n).Value
３：DB.Cells(m, 4).Value = kari.Cells(14, n).Value
４：DB.Cells(m, 4).Value = kari.Cells(22, n).Value
５：DB.Cells(m, 4).Value = kari.Cells(30, n).Value

１～５行目まですべて同じセルに代入していますが、何か間違ってませんか？

この回答へのお礼

ありがとうございます。
間違いです。Ｄｏ以降のみ修正しました。

実際、今試していたのは1行目までで、
実行できていない状態です。

そもそも別ブックのシートからコピペ用のシートに貼り付けた各セルの情報を、
別シートに転記しようとしております。
別ブックでは、列＝項目の情報、行＝品目となっており、
抽出したい情報が入っている列は隣り合っていません。
各情報を任意の１に行品目①の情報①、品目①の情報②、品目①の情報③、・・・
というように並べていきたいのです。

同ブック内のコピペ用シートまでは手作業で行うつもりですが、
今まで簡単なコードしか触ったことがないため、
コードの書き方も正直あいまいです。

少し高度すぎるのでしょうか？

お礼日時：2016/01/20 22:30