Sub Macro23()
' マクロ記録日 : 2009/4/15  ユーザー名 : Mas
' Keyboard Shortcut: Ctrl+
    Dim RowsCount As Integer
    Dim c As Integer
    Dim cOfs As Integer
    Dim r As Integer
    Dim sit As Integer
    Dim ShtLbl As String
    Dim ir As Integer
    Dim rs As Integer
    Dim re As Integer
  ShtLbl = "汚染（スギ）"       '基準の塗装寿命
  cOfs = 9                      '基準の塗装寿命のカラム・オフセット値
    Worksheets(ShtLbl).Activate
    Range("A1").CurrentRegion.Select
    RowsCount = Selection.Rows.Count
 　　　r = 2
Do While r <= RowsCount
  For c = 12 To 36 Step 12      '３暴露地の塗装寿命カラム位置
    Select Case c
    Case Is >= 24
        GoTo Pass1
    End Select
Count1:
    If r > RowsCount Then GoTo End1　'スルー・オーバーフロー防止
    Select Case Len(Cells(r, c))
    Case Is = 0
       r = r + 1: GoTo Count1
    End Select
       rs = r + 2
       r = rs
Count2:
    Select Case Len(Cells(r, c))
    Case Is > 0
       r = r + 1: GoTo Count2
    End Select
       re = r - 1
Pass1:
    r = rs - 1
    Range(Cells(r, c + cOfs), Cells(re, c + cOfs)).Select
    Selection.Copy
    Range(Cells(r, c), Cells(re, c)).Select
    ActiveSheet.Paste
    Range(Cells(r, c + 1), Cells(re, c + 9)).Select
    Selection.ClearContents
    Selection.Interior.ColorIndex = xlNone
    Cells(r, c + 1).Value = "降水量（スギ）"
    Cells(r, c + 2).Value = "降水日数（スギ）"
    Cells(r, c + 3).Value = "積雪日数（スギ）"
    Cells(r, c + 4).Value = "平均気温（スギ）"
    Cells(r, c + 5).Value = "最高気温（スギ）"
    Cells(r, c + 6).Value = "最低気温（スギ）"
    Cells(r, c + 7).Value = "日照時間（スギ）"
    Cells(r, c + 8).Value = "　　　　（スギ）"
    Cells(r, c + 9).Value = "平均風速（スギ）"
    ir = r
        For r = rs To re
            If IsNumeric(Cells(r, c)) Then
              For j = 1 To 9
                Worksheets(Cells(ir, c + j).Value).Select
                Cells(r, c + cOfs).Select
                Selection.Copy
                Worksheets(ShtLbl).Select
                Cells(r, c + j).Select
                ActiveSheet.Paste
              Next j
            Else
            End If
Escape1:
        Next r
  Next c
  r = re + 1
Loop
End1:
End Sub