|
こんな感じかな ?
Sub 成績Copy1()
Dim MyR As Range, C As Range
With Sheets("選手総合成績")
For Each C In .Range("A2", .Range("A65536").End(xlUp))
On Error Resume Next
Set MyR = Sheets(C.Text).Range("A2:G2")
If Err.Number = 0 Then
C.Offset(, 1).Resize(, 7).Value = MyR.Value
Set MyR = Nothing
Else
Err.Clear
End If
On Error GoTo 0
Mext
End With
End Sub
Sub 成績Copy2()
On Error Resume Next
With Sheets("選手総合成績")
.Activate
With .Range("A2", .Range("A65536").End(xlUp)) _
.Offset(, 1).Resize(, 7)
.Formula = _
"=INDIRECT(ADDRESS(2,COLUMN()-1,4,TRUE,$A2))
.Copy
.PasteSpecial xlPasteValues
.SpecialCells(2, 16).ClearContents
End With
End With
.Range("A1").Select
Application.CutCopyMode = False
End Sub
|
|