anonymous No title
No License VBA
2021年03月21日
Copy Clone
Sub 別シートセルの値を習得してシート繰り返しコピー()

'シートセレクト
Sheets("データベース").Select

Dim i 'ループカウンタ
Dim s 'セル値



'A4セルをアクティブ
Range("A4").Select

'ループカウンタ初期化
i = 0

'空セルまでループ
Do
  'セルの値を取得
  s = ActiveCell.Offset(i, 0).Value
  
  
  'セルのr隊が未設定の場合
  If s = "" Then
  
   'ループ抜ける
   Exit Do
 End If
'ループカウンタ加算
i = i + 1

MsgBox i '習得値確認

'シートひな形1をコピー
Worksheets("ひな形1").Copy after:=ActiveSheet

Range("AK25").Value = i

'シートひな形2コピー
ActiveSheet.Name = ActiveSheet.Range("V4")
Worksheets("ひな形2").Copy after:=ActiveSheet

ActiveSheet.Name = ActiveSheet.Range("I3") & "桝設置"

Loop

End Sub


Function RefLeftSheet(objCell As Range) As Variant
'左隣のシートのセル参照マクロ
  
  Application.Volatile
  
  RefLeftSheet = objCell.Parent.Previous.Range(objCell.Address).Value

End Function
Sub 別シートセルの値を習得してシート繰り返しコピー()

'シートセレクト
Sheets("データベース").Select

Dim i 'ループカウンタ
Dim s 'セル値



'A4セルをアクティブ
Range("A4").Select

'ループカウンタ初期化
i = 0

'空セルまでループ
Do
  'セルの値を取得
  s = ActiveCell.Offset(i, 0).Value
  
  
  'セルのr隊が未設定の場合
  If s = "" Then
  
   'ループ抜ける
   Exit Do
 End If
'ループカウンタ加算
i = i + 1

MsgBox i '習得値確認

'シートひな形1をコピー
Worksheets("ひな形1").Copy after:=ActiveSheet

Range("AK25").Value = i

'シートひな形2コピー
ActiveSheet.Name = ActiveSheet.Range("V4")
Worksheets("ひな形2").Copy after:=ActiveSheet

ActiveSheet.Name = ActiveSheet.Range("I3") & "桝設置"

Loop

End Sub


Function RefLeftSheet(objCell As Range) As Variant
'左隣のシートのセル参照マクロ
  
  Application.Volatile
  
  RefLeftSheet = objCell.Parent.Previous.Range(objCell.Address).Value

End Function
No one still commented. Please first comment.