エクセルで、コピーに関するマクロ

質問

CC列に入力されている文字列を以下のようにコピーしたいのですが。

CC1からCC100まで、順番にコピーしていきます。途中に空欄のセルもありますが、それはコピー対象から外します。

コピーの形式と貼り付ける場所ですが、CC1が"school"なら、A1に"s"、B1に"c"、C1に"h"、D1に"o"、E1に"o"、F1に"l"と、横に連なる形でコピーします。
次にCC2が"dog"なら、A2に"d"、B2に"o"、C2に"g"というふうに、先ほどの下の行にコピーします。
次のコピー対象に対しては、A3が貼り付けの起点となります。その次の起点はA4ですが、その次はM1が起点になります。M2、M3と起点が移り、M4までいくとその次はY1が起点となります。Y2、Y3と起点が移り、Y4までいくと次はAK1が起点となり、以後4行ごとに列が変わっていきます。
コピー対象セル内の文字数が13文字以上になると、以後のコピー時にかぶさってしまう部分が発生しますが、それはそれでかまいません。

コピー対象の列は常にCCで、範囲は常に1～100です。また、貼り付けるセルの出発点は常にA1です。
コピー対象セルの数が多いと、CC列にも貼り付けられてしまいますが、実際は空欄セルが多いのでCC列に貼り付けられるケースはまずあり得ません。そういうケースが生じた場合はそのままでかまいません。

上記のことができるマクロを教えてもらいたいのですが。

回答No.2

kokorone · ベストアンサー

Dim base_cnt As Integer
Dim base_cnt1 As Integer
Dim base_word As String
Dim base_length As Integer
Dim word_cnt As Integer
Dim dest_x As Integer
Dim dest_y As Integer

base_cnt1 = 0
For base_cnt = 0 To 99
base_word = Sheets("Sheet1").Range("CC1").Offset(base_cnt, 0)
base_leng = Len(base_word)
If base_leng > 0 Then
dest_x = Int(base_cnt1 / 4) * 12
dest_y = (base_cnt1 Mod 4) + 1

For word_cnt = 1 To base_leng
Sheets("Sheet1").Cells(dest_y, dest_x + word_cnt).Value = Mid(base_word, word_cnt, 1)
Next word_cnt
base_cnt1 = base_cnt1 +1
EndIf

Next base_cnt

お礼

ご回答ありがとうございました。
今度は成功しました。

回答No.1

kokorone

Dim base_cnt As Integer
Dim base_word As String
Dim base_length As Integer
Dim word_cnt As Integer
Dim dest_x As Integer
Dim dest_y As Integer

For base_cnt = 0 To 99
base_word = Sheets("Sheet1").Range("CC1").Offset(base_cnt, 0)
base_leng = Len(base_word)

dest_x = Int(base_cnt / 4) * 12
dest_y = (base_cnt Mod 4) + 1

For word_cnt = 1 To base_leng
Sheets("Sheet1").Cells(dest_y, dest_x + word_cnt).Value = Mid(base_word, word_cnt, 1)
Next word_cnt

Next base_cnt

お礼

ご回答ありがとうございました。

実行してみましたが、以下の部分が反映されていないようでした。

>> 途中に空欄のセルもありますが、それはコピー対象から外します。