各シート調整

Sub 各シート調整()
     
       'シート番号変数宣言
     Dim シート番号 As Long
       '3枚目のシートから最終シートまで同じ処理
     For シート番号 = 4 To Worksheets.Count
        'メールアドレス転記
        Worksheets(シート番号).Range("A3") = Worksheets(シート番号).Range("D6")
        'メールアドレス列削除
        Worksheets(シート番号).Range("D:D").Delete
        '列幅調整
        Worksheets(シート番号).Columns("A:C").AutoFit
        
    Next シート番号

End Sub

各シートに振り分ける

Sub シートへ振分け()

   '変数宣言
  Dim i As Long
  
    'A列をG列にコピーする
    Range("A:A").Copy Range("G1")
    
    'A列の重複なしリストをG列に作成
    Range("G1").CurrentRegion.RemoveDuplicates 1, xlYes
  
       'リストシートを選択
        With Sheets("リストシート")
        
        '7列目(G列)の2行目から最終行まで(重複がない列）
            For i = 2 To Cells(Rows.Count, 7).End(xlUp).Row
            
                'オートフィルタ7列目(G列)で条件設定は重複がない列）
                .Range("A1").AutoFilter 1, .Cells(i, 7)
                
                'シートを1枚追加する
                Sheets.Add After:=Sheets(Sheets.Count)
                
                '追加シート名は、G列のセルの値(重複がない列）
                ActiveSheet.Name = .Cells(i, 7)
   
               '追加シートの5行目以降にコピー
                .Range("A1").CurrentRegion.Copy Range("A5")

            Next i

        End With
  
   'AutoFilterを解除
   Sheets("リストシート").Range("A1").AutoFilter
   
   'リストシートを選択
   Sheets("リストシート").Select
  
End Sub

Sub sheets_save()

Sub sheets_save()

Dim シート As Worksheet

For Each シート In Worksheets

If シート.Name <> "Sheet6" Then

シート.Copy

ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & シート.Name

ActiveWorkbook.Close

End If

Next シート

End Sub

\は円マーク

【VBA】ランダムな日付データ作成

Sub ランダムな日付データ作成()
  Dim fstDate As Date
  Dim lstDate As Date
  Dim 行番号 As Long

  fstDate = #4/1/2011# 'ランダムに作成する最初の日
  lstDate = #9/30/2011# 'ランダムに作成する最後の日

  Randomize
  For 行番号 = 1 To 1000
     Cells(行番号, 2) = Int((lstDate - fstDate + 1) * Rnd + fstDate)
     Cells(行番号, 2).NumberFormat = "yyyy""年""mm""月""dd""日"""
  Next 行番号

End Sub

【VBA】 指定文字列をランダム入力

Sub 指定文字列をランダム入力()
  Dim arr(1 To 6) As String
  Dim 行番号 As Long
     
  arr(1) = "スターバックスラテ"
  arr(2) = "カフェモカ"
  arr(3) = "ホワイトモカ"
  arr(4) = "ソイラテ"
  arr(5) = "カプチーノ"
  arr(6) = "キャラメルマキアート"
    
  Randomize
  
    For 行番号 = 1 To 100000
    
        Cells(行番号, 2) = arr(Int*1
           
    Next 行番号

End Sub

*1:Rnd * 6) + 1