다른 셀의 매크로 실행

Question

D2와 같은 셀에서 매크로를 실행하고 싶습니다. D2를 활성 셀로 사용합니다. 결과를 얻으려면 모든 셀에서 매크로를 실행할 수 있습니까? 아래의 코드는 내가

Sub Allocation() 

' 
' Allocation Macro 
' 
' Keyboard Shortcut: Ctrl+g 
' 
    Selection.TextToColumns Destination:=ActiveCell, DataType:=xlDelimited, _ 
     TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _ 
     Semicolon:=True, Comma:=True, Space:=True, Other:=True, FieldInfo:= _ 
     Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1)), _ 
     TrailingMinusNumbers:=True 
    ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select 
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
    ActiveCell.Offset(-1, 4).Range("A1").Select 
    Range(Selection, Selection.End(xlToRight)).Select 
    Selection.Copy 
    ActiveCell.Offset(1, -1).Range("A1").Select 
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ 
     False, Transpose:=True 
    ActiveCell.Offset(-1, -3).Range("A1:C1").Select 
    Application.CutCopyMode = False 
    Selection.AutoFill Destination:=ActiveCell.Range("A1:C16"), Type:= _ 
     xlFillDefault 
    ActiveCell.Range("A1:C16").Select 
    ActiveCell.Offset(0, 4).Range("A1").Select 
    Range(Selection, Selection.End(xlToRight)).Select 
    Selection.ClearContents 
End Sub 

Answer 1

그것은 당신이 후있어,하지만 나에게 100 % 확실하지 않다 단지 하나 개의 셀에 매크로를 실행할 수 있습니다 처음에 선택한 셀의 범위를 통해이 반복됩니다 :

Sub Allocation() 

' 
' Allocation Macro 
' 
' Keyboard Shortcut: Ctrl+g 
' 
Dim r As Range, c 
Set r = Selection 
For c = 1 To r.Count 
    r(c).Select 
     Selection.TextToColumns Destination:=ActiveCell, DataType:=xlDelimited, _ 
     TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _ 
     Semicolon:=True, Comma:=True, Space:=True, Other:=True, FieldInfo:= _ 
     Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1)), _ 
     TrailingMinusNumbers:=True 
     ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select 
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
     ActiveCell.Offset(-1, 4).Range("A1").Select 
     Range(Selection, Selection.End(xlToRight)).Select 
     Selection.Copy 
     ActiveCell.Offset(1, -1).Range("A1").Select 
     Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ 
      False, Transpose:=True 
     ActiveCell.Offset(-1, -3).Range("A1:C1").Select 
     Application.CutCopyMode = False 
     Selection.AutoFill Destination:=ActiveCell.Range("A1:C16"), Type:= _ 
      xlFillDefault 
     ActiveCell.Range("A1:C16").Select 
     ActiveCell.Offset(0, 4).Range("A1").Select 
     Range(Selection, Selection.End(xlToRight)).Select 
     Selection.ClearContents 
Next 
End Sub