Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


43827 / 76732 ←次へ | 前へ→

【37932】Re:別シート表から空欄行を検索し番号を取得する
お礼  hana  - 06/5/23(火) 16:42 -

引用なし
パスワード
   ありがとうございます。
ビギナーの為、理解に時間かかるかと思いますが
成功しましたら、ご報告させていただきます。

▼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

0 hits

【37911】別シート表から空欄行を検索し番号を取得する hana 06/5/23(火) 10:33 質問
【37912】Re:別シート表から空欄行を検索し番号を取... Statis 06/5/23(火) 10:43 発言
【37913】Re:別シート表から空欄行を検索し番号を取... hana 06/5/23(火) 11:44 お礼
【37914】Re:別シート表から空欄行を検索し番号を取... Statis 06/5/23(火) 11:54 回答
【37917】Re:別シート表から空欄行を検索し番号を取... hana 06/5/23(火) 14:10 お礼
【37918】Re:別シート表から空欄行を検索し番号を取... Kein 06/5/23(火) 14:20 回答
【37932】Re:別シート表から空欄行を検索し番号を取... hana 06/5/23(火) 16:42 お礼

43827 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free