Excel VBA質問箱 IV

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

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


43841 / 76732 ←次へ | 前へ→

【37918】Re:別シート表から空欄行を検索し番号を取得する
回答  Kein  - 06/5/23(火) 14:20 -

引用なし
パスワード
   >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 お礼

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