Selecting discontiguous ranges using and application. inputbox and pasting selection to another working.

[Tanner_2004]

Hi Folks

Maybe you can help me. My code works fine as long as I select ranges that have the same number of columns.

I use an application input box to capture the ranges (several ranges of various sizes) by using the control and left mouse button. It traps the addresses f the multiple ranges just fine, it will ot however, paste the range values to another worksheet (or any worksheet) unless the ranges start and end on the same columns.

Here is the code...any help would be greatly appreciated. Thank you.

[FONT=Calibri][SIZE=3][COLOR=#000000]Sub SelectTablelRange()[/COLOR][/SIZE][/FONT]

[FONT=Times New Roman][SIZE=3][COLOR=#000000][FONT=Calibri][SIZE=3][COLOR=#000000]    Dim MyRange AsRange[/COLOR][/SIZE][/FONT][/COLOR][/SIZE][/FONT]

[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]    DimSelectionAnswer As Range[/COLOR][/SIZE][/FONT]

[FONT=Times New Roman][SIZE=3][COLOR=#000000][FONT=Calibri][SIZE=3][COLOR=#000000]'  Sheet26 isStoredCopiedRange. This is where the rows that Tom has selected are pasted to [/COLOR][/SIZE][/FONT]
[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][FONT=Calibri][SIZE=3][COLOR=#000000] [/COLOR][/SIZE][/FONT]
[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][FONT=Calibri][SIZE=3][COLOR=#000000]'  Clears thedestination worksheet prior to pasting[/COLOR][/SIZE][/FONT]
[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][FONT=Calibri][SIZE=3][COLOR=#000000]  Sheet26.Cells.Clear[/COLOR][/SIZE][/FONT]
[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000] Application.DisplayAlerts = False[/COLOR][/SIZE][/FONT]

[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000] On Error Resume Next[/COLOR][/SIZE][/FONT]

[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][FONT=Calibri][SIZE=3][COLOR=#000000]   Set SelectionAnswer= Application.InputBox("Please select the row ranges that you want toemail. " _[/COLOR][/SIZE][/FONT]
[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]   & vbCrLf &"You can use the Control key and left mouse click to make yourselections.", "Select Range", , , , , , 8)[/COLOR][/SIZE][/FONT]

[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]   If SelectionAnswerIs Nothing Then[/COLOR][/SIZE][/FONT]

[FONT=Times New Roman][SIZE=3][COLOR=#000000][FONT=Calibri][SIZE=3][COLOR=#000000]    MsgBox "Youhave selected nothing."[/COLOR][/SIZE][/FONT]
[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][FONT=Calibri][SIZE=3][COLOR=#000000]    On Error GoToLeave[/COLOR][/SIZE][/FONT]
[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][FONT=Calibri][SIZE=3][COLOR=#000000]  Else[/COLOR][/SIZE][/FONT]
[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][FONT=Calibri][SIZE=3][COLOR=#000000]    MsgBox "Youhave selected: " & SelectionAnswer.Address[/COLOR][/SIZE][/FONT]
[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][FONT=Calibri][SIZE=3][COLOR=#000000] [/COLOR][/SIZE][/FONT][/COLOR][/SIZE][/FONT]

[FONT=Times New Roman][SIZE=3][COLOR=#000000][FONT=Times New Roman][SIZE=3][COLOR=#000000][FONT=Calibri][SIZE=3][COLOR=#000000]   SelectionAnswer.Copy Sheet26.Range("A1")[/COLOR][/SIZE][/FONT]
[/COLOR][/SIZE][/FONT][/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][FONT=Calibri][SIZE=3][COLOR=#000000] [/COLOR][/SIZE][/FONT]
[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][FONT=Calibri][SIZE=3][COLOR=#000000]   WithSheet26.Range("A1")[/COLOR][/SIZE][/FONT]
[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][FONT=Calibri][SIZE=3][COLOR=#000000]       .PasteSpecialxlPasteFormats[/COLOR][/SIZE][/FONT]
[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][FONT=Calibri][SIZE=3][COLOR=#000000]       .PasteSpecialxlPasteAllUsingSourceTheme[/COLOR][/SIZE][/FONT]
[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][FONT=Calibri][SIZE=3][COLOR=#000000]       .PasteSpecialxlPasteAll[/COLOR][/SIZE][/FONT]
[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][FONT=Calibri][SIZE=3][COLOR=#000000]   [/COLOR][/SIZE][/FONT][/COLOR][/SIZE][/FONT]

[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]     End With[/COLOR][/SIZE][/FONT]

[FONT=Times New Roman][SIZE=3][COLOR=#000000][FONT=Calibri][SIZE=3][COLOR=#000000] [/COLOR][/SIZE][/FONT][FONT=Times New Roman][SIZE=3][COLOR=#000000][FONT=Calibri][SIZE=3][COLOR=#000000]  End If[/COLOR][/SIZE][/FONT]
[/COLOR][/SIZE][/FONT][/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][FONT=Calibri][SIZE=3][COLOR=#000000]Cells.SpecialCells(xlCellTypeConstants, 23).Columns.AutoFit[/COLOR][/SIZE][/FONT]
[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][FONT=Calibri][SIZE=3][COLOR=#000000]Sheet26.Columns.AutoFit[/COLOR][/SIZE][/FONT]
[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][FONT=Calibri][SIZE=3][COLOR=#000000] [/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]Leave:[/COLOR][/SIZE][/FONT]
[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][FONT=Calibri][SIZE=3][COLOR=#000000]

[FONT=Calibri][SIZE=3][COLOR=#000000] Application.DisplayAlerts= True[/COLOR][/SIZE][/FONT][/COLOR][/SIZE][/FONT][/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]End Sub[/COLOR][/SIZE][/FONT]

[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT]

 

[footoo]

Where do you want to paste the discontiguous ranges?
For example, if the selection is B1:B3/C3:C6/F2:F7, where to paste on Sheet26?