need a processional look at my challenge

[mike8791]

I would like some help on this Task. I'm doing this for work. I would like a VBA code that if it runs:
1- It promote a box asking to open a workbook. 2- in the opened workbook i would like to copy then transpose a range values to the "vba workbook i.e. the original one opened".
3- It asks then where do you want to paste them however all data should create one long column.


i have found this code but i feel it needs a professional look at:



Sub tanspseandcopyfromopenoptionworkbook()
Dim xRng As Range
Dim Xnew As Range
Dim i As Integer
Dim xLastRow As Integer
Dim xTxt As String
Dim FileToOpen As Variant
Dim OpenBook As Workbook
On Error Resume Next

' open file
FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*),*xls*")
If FileToOpen <> False Then
Set OpenBook = Application.Workbooks.Open(FileToOpen)
End If
' open file
On Error Resume Next
xTxt = Application.ActiveWindow.RangeSelction.Address
Set Xnew = Application.InputBox("select data range", "Kutools", xTxt, , , , , 8)
If Xnew Is Nothing Then Exit Sub



xLastRow = Xnew.Columns(i).Rows.Count + 1
For i = 2 To Xnew.Columns.Count
Range(Xnew.Cells(1, i), Xnew.Cells(Xnew.Columns(i).Rows.Count, i)).Cut

ActiveSheet.Paste Destination:=Xnew.Cells(xLastRow, 1)
xLastRow = xLastRow + Xnew.Columns(i).Rows.Count
Next
'PasteSpecial_Examples (Xnew)
End Sub







Sub PasteSpecial_Examples()
Workbooks("Testing.xlsm").Worksheets("Sheet1").Range("D3:N14").Copy
ActiveSheet.Range("C26").PasteSpecial Transpose:=True
End Sub

 

[mumps]

Try:

Sub CopyRange()
    Dim flder As FileDialog, FileName As String, FileChosen As Integer, srcWB As Workbook, desWS As Worksheet
    Dim copyRng As Range, desCol As String, i As Long
    Set desWS = ThisWorkbook.Sheets("Sheet1")
    Set flder = Application.FileDialog(msoFileDialogFilePicker)
    flder.Title = "Please Select a Excel Macro File"
    FileChosen = flder.Show
    FileName = flder.SelectedItems(1)
    Set srcWB = Workbooks.Open(FileName)
    Set copyRng = Application.InputBox(Prompt:="Select a range to copy.", Title:="Range Selection", Type:=8)
    desCol = InputBox("Enter the column letter where you want to paste.")
    If desCol = "" Then Exit Sub
    For i = 1 To copyRng.Columns.Count
        With desWS
            copyRng.Cells(1, i).Resize(copyRng.Columns(i).Cells.Count).Copy .Cells(.Rows.Count, desCol).End(xlUp).Offset(1)
        End With
    Next i
    ActiveWorkbook.Close False
End Sub

 

[mike8791]

Well Thank you so much on your effort Mr mumps.

I still need the copied ranged to be transposed before its pasted onto one column in the VBA Workbook.
help on this please
You Code is Great!!

 

[mumps]

all data should create one long column.

This seems to indicate that the data from each column should be placed vertically into the destination column not transposed. Please clarify what you mean by the above quote. It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of the sheet containing the data to be copied and also of the destination sheet. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).

 

[mike8791]

Hello Fellow,
with your amazing vba code i was be able to open a file and copy and arrange the data in on Long Column. However I'm missing one step "Copy - Transpose - One Long Column".

This is the shared link to the file explaining in brief what I'm looking for. I'm just missing the Transpose Part

Dropbox

www.dropbox.com

 

[mumps]

Try:

Sub CopyRange()
    Dim flder As FileDialog, FileName As String, FileChosen As Integer, srcWB As Workbook, desWS As Worksheet
    Dim copyRng As Range, desCol As String, i As Long
    Set desWS = ThisWorkbook.Sheets("Sheet1")
    Set flder = Application.FileDialog(msoFileDialogFilePicker)
    flder.Title = "Please Select a Excel Macro File"
    FileChosen = flder.Show
    FileName = flder.SelectedItems(1)
    Set srcWB = Workbooks.Open(FileName)
    Set copyRng = Application.InputBox(Prompt:="Select a range to copy.", Title:="Range Selection", Type:=8)
    desCol = InputBox("Enter the column letter where you want to paste.")
    If desCol = "" Then Exit Sub
    For i = 1 To copyRng.Columns.Count
        With desWS
            copyRng.Cells(1, i).Resize(copyRng.Columns(i).Cells.Count).Copy
            .Cells(.Rows.Count, desCol).End(xlUp).Offset(1).PasteSpecial Transpose:=True
        End With
    Next i
    ActiveWorkbook.Close False
End Sub

 

[mike8791]

I'm really sorry for that. Your Code modification has hold the last part i wish i could have which is pasting all as one Column.

 

[mumps]

I’m sorry but I don’t understand what you mean. Please clarify in detail.

 

[mike8791]

Could you check the shared File. I have a data i wish:
1- Copy them.
2- Transpose the copied data.
2- Paste them as casted one column.
you can check the link to dropbox may be its possible you understand my point clear.


MrMumps

 

[mike8791]

the first code you have provided is working well but the data is not arranged in a suitable way i.e. transposed before its pasted as one column.
the second code has solved the Transposed part but never stack the results as one Column.
i wish slight modification to just stack the second code you have provided onto One long column.