表内の斜め左半分を選択するマクロコードがわかりません？

質問

Windows XP　Home Edition
Excel　2002

表内の緑色の斜め左下半分（緑色）だけをB8の右へ順次貼り付けたいのですが、うまく動作してくれません。
番号行（グレー色）は、各シートによって違ってきます。
各シートの表は、必ず、当表のように対角線状だけ空白セルになっております。

ほんとは、表内の緑色のデータだけを選択さえできればいいのですが、自分の能力では、
　当質問内容の方法しか考えつきませんでした。

何卒、ご教授お願い致します。

Sub 斜め左半分を選択()
Dim r As Range
　With ActiveSheet
　For Each r In .Range("A4", .Range("A4").End(xlDown))
　　Range(r.Offset(0, 1), .r.End(xlToRight)).Copy _
　　Destination:=r.End(xlDown).Offset(1, 1).End(xlToRight).Offset(0, 1)
　Next r
　End With
End Sub

回答No.1

kybo · ベストアンサー

一応、出来てると思います。

Sub 斜め左半分を選択()
Dim r As Range
With ActiveSheet
For Each r In .Range("A4", .Range("A4").End(xlDown))
Range(r.Offset(0, 1), r.End(xlToRight)).Copy _
Destination:=.Range("A4").End(xlDown).Offset(1, 255).End(xlToLeft).Offset(0, 1)
Next r
End With
End Sub

お礼

ご回答、誠に有難うございました。

補足

早速のご回答、誠に有難うございました。
バッチリでした。
当方の原因を確認してみました。
当方としては、まだ、ざっとですが、原因が解かることができました。

ご回答内容には全く問題はありませんが。
大変申し訳ありませんが、1点だけどうも解かりませ。
もし、よろしかったらで結構です、お時間のある時で結構ですので、
よろしくお願い致します。

１、Range(r.Offset(0, 1), r.End(xlToRight)).Copy _
の部分だけなんですが、
これを画像のシートの4行目だけに対して手動だけで行いますと、
D4の3までも選択してしまうのですが、
どおしてkybo様のご回答されたコードを実行すると、
4行目はB4の4だけをきちんと正常に参照するのでしょうか？

初歩的な事で申し訳ありません。

回答No.4

kybo

>１、Range(r.Offset(0, 1), r.End(xlToRight)).Copy _
>の部分だけなんですが、
>これを画像のシートの4行目だけに対して手動だけで行いますと、
>D4の3までも選択してしまうのですが、

oshietecho-daiさんのコードは以下です。
Range(r.Offset(0, 1), .r.End(xlToRight)).Copy
これは変数の前に「.」を付けているので誤りです。

変数rはA4から、この場合A7までループしますが、r.Offset(0, 1)はB4～B7で、
.r.End(xlToRight)はA4からCtrl+→を押したときの連続した最終列となりますので、最初に記述したコードで間違っているのは変数の前のピリオドのみです。

提示されたコードでは「D4の3までも選択してしまうのですが」にはなりません。
実際に記述しているコードと掲載しているコードが違うのではないでしょうか。

お礼

ご回答、誠に有難うございました。

補足

当方の質問の説明不足で大変申し訳ありません。
kybo様のご回答の全コードは100%キッチリ間違いなく動作しましたので、
問題はございません。
>１、Range(r.Offset(0, 1), r.End(xlToRight)).Copy _
>の部分だけなんですが、
>これを画像のシートの4行目だけに対して手動だけで行いますと、
>D4の3までも選択してしまうのですが、
VBAの機能を使用しないで、まったくの手動だけで、
私が、
セルB4を選択し、「 shift+ctrl 」＋「→（end）」キーを押しますと、
飛び越えてセルD4の3までも選択されてしまいます。
この手動の方法は、根本的に、「>１、・・・」のマクロコードとは
違うと解釈すればよろしいでしょうか？

度々と申し訳ありません。
もし、よろしかったらで結構です、お時間のある時で結構ですので、
よろしくお願い致します。
ご回答して頂かなかったとしても、また別の質問として投稿しますので
どちらでもよろしいでございます。

回答No.3

imogasi

A列で番号２を探し、そこから番号が途切れる直前行までを対象に
表の三角部分の１行化をやってみました。
表が複数あるようなので、表（データ塊）について繰り返します。
Range("a" & sm & ":A" & 100).Find(2).Rowで判るように、とりあえず１０１行以下に表はないものと仮定してます。この点変えられます。
またFor m = 1 To 10で判るように１１表以上ないものと仮定しています。
この点変えられます。
下記テスト例では、セルの値は文字列にしてますが、数値でも同じです。
ーーー
Sub test01()
sm = 1
For m = 1 To 10
s = Range("a" & sm & ":A" & 100).Find(2).Row
MsgBox s
If s = sm Then Exit Sub
e = Range("A" & s).End(xlDown).Row
MsgBox e
r = 1
k = 2
For i = s To e
r = r + 1
For j = 2 To r
Cells(e + 1, k) = Cells(i, j)
k = k + 1
Next j
Next i
sm = s
Next m
End Sub
テスト例データ　A1:第１６行
と実行結果です。
番号
1
2 a
3 b e
4 c f h
5 d g i・・・略
ー a b e・・・秘儀列略＜＝＝結果データ行
ー
番号
1
2 x
3 y aa
4 z bb ff
5 u cc gg・・・略
6 v cdd hh・・・略
ー x y aa・・・右列略＜＝＝結果データ行
（－は空白セルを表すシルシです）

お礼

ご回答、誠に有難うございました。
皆様バッチリでした。

補足

早速のご回答、誠に有難うございました。
バッチリでした。
全表にまでも実行してしまうんですね。
すごい！！
MsgBox 大変便利です。
レベル高すぎです！

回答No.2

xls88

とりあえず下記のようにしてみました。

Dim r As Range
Dim n As Integer
n = 1
With ActiveSheet
For Each r In .Range("A4", .Range("A4").End(xlDown))
With .Range(r.Offset(0, 1), r.End(xlToRight))
.Copy ActiveSheet.Range("A8").Offset(, n)
n = n + .Count
End With
Next r
End With

お礼

ご回答、誠に有難うございました。
皆様バッチリでした。

補足

早速のご回答、誠に有難うございました。
試しました、バッチリでした。