特定のヘッダーを持つ列を追加し、すべての行に既定値を設定するマクロ

Question

最後のヘッダーセルの隣に新しい列を追加し、新しい列にいくつかのランダムな値を入力する必要があります。 "与えられたワークシートに

以下

私のマクロである：

Sub sbInsertingColumns(sourceFile As String, Worksheet As String) 
Dim lastColName As String 
Dim LastColumn As Long 
    With ActiveSheet 
     LastColumn = Workbooks(sourceFile).Worksheets(Worksheet).Range("A1").End(xlToRight).Column 
    End With 
    Dim nextCell As Integer 
    nextCell = Val(LastColumn) + Val(1) 

    lastColName = Replace(Replace(Cells(1, nextCell).Address, "1", ""), "$", "") 
    Workbooks(sourceFile).Worksheets(Worksheet).Range(lastColName & 1).Value = "New Header" 
    MsgBox "New Column has been added : [ " & lastColName & 1 & "]" 
End Sub 

は、値を追加する：

Sub Add() 
    Dim cellVal As String 
    Dim cell As Range 
    cellVal = .Range("E") 
    For Each cell In Sheets("Sheet1").Range("E:e").SpecialCells(xlCellTypeConstants, xlNumbers) 
     cell.Value = "Cool !" 
    Next cell 
End Sub 

を私はいくつかのヘッダーで新しい列を追加することができるが、新しい列に値を追加するための上記の論理であります働いていない。誰でも私を助けてくれますか？ お時間をありがとう！

Answer 1

Sub sbInsertingColumns(sourceFile As String, Worksheet As String) 

    Dim sht As Worksheet 
    Set sht = Workbooks(sourceFile).Worksheets(Worksheet) 

    With sht.Range("A1").End(xlToRight).Offset(0, 1) 
     Application.Intersect(sht.UsedRange.EntireRow, .EntireColumn).Value = "Cool !" 
     .Value = "New Header" 
    End With 

End Sub 

Answer 2

次のように私は行くだろう：次のようにいくつかの「メイン」サブで使用する

Sub sbInsertingColumns(sourceFile As String, sheetName As String, headerName As String) 
    With Workbooks(sourceFile).Worksheets(sheetName).UsedRange 
     With .Columns(.Columns.Count).Offset(, 1) 
      .Value = "Cool !" 
      .Cells(1, 1) = headerName 
     End With 
    End With 
End Sub 

を：

Sub main() 
    sbInsertingColumns ActiveWorkbook.Name, ActiveSheet.Name, "newheader" 
End Sub 

次のようにまた、あなたのパラメータのリストを下に短縮することができます：

Sub sbInsertingColumns(ws As Worksheet, headerName As String) 
    With ws.UsedRange 
     With .Columns(.Columns.Count).Offset(, 1) 
      .Value = "Cool" 
      .Cells(1, 1) = headerName 
     End With 
    End With 
End Sub 

とし、それをfollo ws

Sub main() 
    sbInsertingColumns ActiveSheet, "newheader" 
End Sub