dynamic目标VBA

我试图让我的VBA目标到ActiveCell下面的单元格。 现在，它只是想把它放在R2中。 我曾尝试使用偏移量将其向下移动一个单元格，但没有任何运气。 arrays通常会像Doe，John [e-mail]那样。

Sub MailMergeNames() ' ' MailMergeNames Macro ' ' Keyboard Shortcut: Ctrl+Shift+M ' ' ' Shift line to rows ' Selection.TextToColumns Destination:=Range("R1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _ Semicolon:=True, Comma:=False, Space:=False, Other:=False, OtherChar _ :="<", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _ 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12 _ , 1), Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), _ Array(19, 1), Array(20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array( _ 25, 1), Array(26, 1), Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), _ Array(32, 1), Array(33, 1), Array(34, 1), Array(35, 1), Array(36, 1), Array(37, 1), Array( _ 38, 1), Array(39, 1), Array(40, 1), Array(41, 1), Array(42, 1), Array(43, 1), Array(44, 1), _ Array(45, 1), Array(46, 1), Array(47, 1), Array(48, 1), Array(49, 1), Array(50, 1), Array( _ 51, 1), Array(52, 1), Array(53, 1), Array(54, 1), Array(55, 1), Array(56, 1), Array(57, 1), _ Array(58, 1), Array(59, 1), Array(60, 1), Array(61, 1), Array(62, 1), Array(63, 1), Array( _ 64, 1), Array(65, 1), Array(66, 1), Array(67, 1)), TrailingMinusNumbers:=True Range("R1:CJ1").Select Selection.Copy Range("R2").Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True Application.CutCopyMode = False ' ' Trim Values ' Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Dim Cell As Range 'Also Treat CHR 0160, as a space (CHR 032) Selection.Replace what:=Chr(160), Replacement:=Chr(32), _ LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False 'Trim in Excel removes extra internal spaces, VBA does not On Error Resume Next 'in case no text cells in selection For Each Cell In Intersect(Selection, _ Selection.SpecialCells(xlConstants, xlTextValues)) Cell.Value = Application.Trim(Cell.Value) Next Cell On Error GoTo 0 Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True ' ' Deliminate Rows to Columns ' Selection.TextToColumns Destination:=Range("R2"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _ Semicolon:=True, Comma:=True, Space:=True, Other:=True, OtherChar:= _ "<", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)) _ , TrailingMinusNumbers:=True Range("R1", "AAA1").Clear Range("R2").Select End Sub