Excel VBA質問箱 IV

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

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


56314 / 76736 ←次へ | 前へ→

【25179】Re:別シートに代入するには
質問  にしもり  - 05/5/23(月) 20:13 -

引用なし
パスワード
   こんにちは。
ニーズがまた少し変わりました。

アクティヴシートのF3から、1つ飛ばしながら、SHEET1のD2からD33にはいっている値を順次入れます。
T3まできたら次行に移り、今度はF4から、1列飛ばしながら、SHEET1のD2からD33のうちまだ入れていない値を順次入れます。
N4まできたら次行に移り、今度はF5から、1列飛ばしながら、SHEET1のD2からD33のうちまだ入れていない値を順次入れます。
N5まできたら次行に移り、今度はF6から、1列飛ばしながら、SHEET1のD2からD33のうちまだ入れていない値を順次入れます。

N6まできたら次行に移り、今度はF7から、1列飛ばしながら、SHEET1のD2からD33のうちまだ入れていない値を順次入れます。
このときSHEET1がD33に達していたらD2に戻ることとします。
N7まできたら次行に移り、今度はF8から、1列飛ばしながら、SHEET1のD2からD33のうちまだ入れていない値を順次入れます。
このときSHEET1がD33に達していたらD2に戻ることとします。
N8まできたら次行に移り、今度はF9から、1列飛ばしながら、SHEET1のD2からD33のうちまだ入れていない値を順次入れます。
このときSHEET1がD33に達していたらD2に戻ることとします。
N9まできたら次行に移り、今度はF10から、1列飛ばしながら、SHEET1のD2からD33のうちまだ入れていない値を順次入れます。
このときSHEET1がD33に達していたらD2に戻ることとします。

このように、N90が埋まるまで繰り返したいのです。
自力でここまできましたがループしてしまい、終わりません。
どこが悪いか、どなたかご教示くださいませんでしょうか。

  Sub Macro1()
  Dim i As Long
  Dim k As Long
  Dim m As Long
  Dim p As Long
  Dim n As Long

  Range("F3").Select
  m = 6
  i = 2
 
  Do While i <= 9
     Cells(ActiveCell.Row, m).Select
     ActiveCell = Worksheets("sheet1").Cells(i, 4).Value
     i = i + 1
     m = m + 2
  Loop
  
  Do While n <= 87
    k = -14
    Do While k <= -6
      n = 1
      ActiveCell.Offset(n, k) = Worksheets("sheet1").Cells(i, 4).Value
      i = i + 1
      if i = 30 Then i = 2
      k = k + 2
    Loop
  Loop

  End Sub
0 hits

【25112】別シートに代入するには にしもり 05/5/20(金) 13:59 質問
【25126】Re:別シートに代入するには ウッシ 05/5/20(金) 16:16 回答
【25158】Re:別シートに代入するには にしもり 05/5/23(月) 9:51 質問
【25179】Re:別シートに代入するには にしもり 05/5/23(月) 20:13 質問
【25183】Re:別シートに代入するには ponpon 05/5/23(月) 23:37 回答
【25193】Re:別シートに代入するには にしもり 05/5/24(火) 9:10 質問
【25232】Re:別シートに代入するには ponpon 05/5/24(火) 23:01 発言
【25234】Re:別シートに代入するには ウッシ 05/5/24(火) 23:54 回答
【25236】Re:別シートに代入するには ponpon 05/5/25(水) 0:20 発言
【25243】Re:別シートに代入するには にしもり 05/5/25(水) 9:23 お礼

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