|
ありがとうございます。
ビギナーの為、理解に時間かかるかと思いますが
成功しましたら、ご報告させていただきます。
▼Kein さん:
>>1.新規シートを作成して→2.オリジナルの表からコピベ→3.台帳(Sheet1)から
>>番号を自動で取得(シート名を取得した番号に変更)
>こんな感じかな ?
>
>Sub Mk_Sheets()
> Dim CpR As Range, MyR As Range, C As Range
> Dim Sname As String
> Dim MyS As Worksheet, Sh As Worksheet
>
> Set MyS = Worksheets("Sheet1")
> Application.ScreenUpdating = False
> On Error GoTo ELine
> With MyS.Range("C2", MyS.Range("C65536").End(xlUp))
> Set CpR = .Offset(, -2).Resize(, 6)
> With .Offset(, 253)
> .Formula = "=IF(COUNTBLANK($D2:$F2)=3,1,"""")"
> Set MyR = .SpecialCells(3, 1)
> End With
> End With
> On Error GoTo 0
> For Each C In MyR
> Sname = CStr(C.Offset(, -253).Value)
> On Error Resume Next
> Set Sh = Worksheets(Sname)
> If Err.Number <> 0 Then
> Set Sh = Worksheets.Add(After:=ActiveSheet)
> Sh.Name = Sname: Err.Clesr
> End If
> On Error GoTo 0
> CpR.Copy Sh.Range("A65536").End(xlUp).Offset(1)
> Set Sh = Nothing
> Next
>ELine:
> Set MyR = Nothing: Set CpR = Nothing
> MyS.Range("IV:IV").ClearContents: Set MyS = Nothing
> Application.ScreenUpdating = True
>End Sub
|
|