| |
合ってましたか。良かった。
昨日は混乱すると思いあえて必要最小限の改造としましたが
以下のようにシートを切り替えなくて済むようにできます。
Sub サンプル2()
Dim 貼付行 As Long
Dim コピー行 As Long
貼付行 = 1
コピー行 = 2
Sheets("Sheet2").Select
Do Until Sheets("Sheet1").Cells(コピー行, "A").Value = ""
'Cells()やRange()の前にシート名を書くと、書いたシート名の
'セルと言うことになります。
Sheets("Sheet1").Range("A1:D1").Copy
'シート名が付いていないと現在表示しているシートのセルになります。
Cells(貼付行, "A").Select
Selection.PasteSpecial Paste:=xlPasteAll, _
Operation:=xlNone, SkipBlanks:=False, _
Transpose:=True
Sheets("Sheet1").Cells(コピー行, "A").Resize(, 4).Copy 'Resizeで4列にする
'上ではCells().Select→Selection.PasteSpecialと２段階で書いてますが
'実は下のようにCells()..PasteSpecialと１つに纏められます。
Cells(貼付行, "B").PasteSpecial Paste:=xlPasteAll, _
Operation:=xlNone, SkipBlanks:=False, _
Transpose:=True
貼付行 = 貼付行 + 4
コピー行 = コピー行 + 1
Loop
End Sub
またシートの指定もサンプル3のようにWith〜End Withで纏めることが出来ます。
Sub サンプル3()
'書き方１
Sheets("Sheet1").Range("A1:D1").Interior.ColorIndex = 3
Sheets("Sheet1").Cells(1, 1).Interior.ColorIndex = 4
'書き方２(書き方１と同じ意味になる)
With Sheets("Sheet1")
.Range("A1:D1").Interior.ColorIndex = 3
.Cells(1, 1).Interior.ColorIndex = 4
End With
'−−−−−
Sheets("Sheet2").Select
With Sheets("Sheet1")
.Range("A1:D1").Interior.ColorIndex = 3 'Sheet1のA1〜D1
'↓これは.で始まっていないのでwithの影響を受けない
'(=現在表示されているシートのCells(1,1)ということになる)
Cells(1, 1).Interior.ColorIndex = 5
.Cells(1, 1).Interior.ColorIndex = 4 'Sheet1のA1
End With
End Sub
時間があるときにヘルプを読んだりしてみてくださいませ。
|
|
へっぽこ
- 07/1/18(木) 12:14 -
