vba copy a vertical range and paste horizontal

[drop05]

Hello, is there way to copy a range that is vertical and paste it horizontal.
i have this code and to copy from a selected workbook/sheet
code:
copy_wb.Worksheets("Sheet1").Range("h29:s29").Copy

and the range i need it to paste to is in another workbook/sheet

code:
paste_wb.Worksheets("Sheet2").Range("d27:d38").PasteSpecial Paste:=xlPasteValues

just need the values to paste, is there a way to get that horizontal range to copy it and paste vertically

so h29 will go to d27
i29 to d28
j29 to d29
and so on

 

[johnnyL]

The following code will work for one worksheet to another worksheet in the same workbook:

Sub TransposeHorizontalRangeValuesToVerticalRangeInAnotherSheet()
    Dim TmpArray() As Variant, SourceRange As Range, DestinationRange As Range

    Set SourceRange = Sheets("Sheet1").Range("H29:S29")         '
    Set DestinationRange = Sheets("Sheet2").Range("D27")  '

    TmpArray = Application.Transpose(SourceRange.Value)
    DestinationRange.Resize(SourceRange.Columns.Count, SourceRange.Rows.Count).Value = TmpArray
End Sub

 

[drop05]

The following code will work for one worksheet to another worksheet in the same workbook:

Sub TransposeHorizontalRangeValuesToVerticalRangeInAnotherSheet()
    Dim TmpArray() As Variant, SourceRange As Range, DestinationRange As Range

    Set SourceRange = Sheets("Sheet1").Range("H29:S29")         '
    Set DestinationRange = Sheets("Sheet2").Range("D27")  '

    TmpArray = Application.Transpose(SourceRange.Value)
    DestinationRange.Resize(SourceRange.Columns.Count, SourceRange.Rows.Count).Value = TmpArray
End Sub

THANK YOU!
How would this work from one workbook to another?
as i am also going to do this for multiple ranges too
i have code to where the user selects the two workbooks being used and opens then closes them

 

[johnnyL]

Post the code and we can go from there.

 

[drop05]

Post the code and we can go from there.

Here is my code as an example with what i was doing before, but would like to copy the horizontal and paste to vertical

Sub Get_data()

Dim FileToOpen As Variant
Dim FileToPaste As Variant
Dim In_wb As Workbook
Dim admn_wb As Workbook
Dim Total As Double
Dim Yes As String
Dim Blank As String

Application.ScreenUpdating = False

Blank = "Blank"
Yes = "Yes"
No = "No"


'open workbook
FileToOpen = Application.GetOpenFilename(Title:="Browse for File To Copy Data", FileFilter:="All Files(*.*),*.*")
FileToPaste = Application.GetOpenFilename(Title:="Browse for File To Paste Data", FileFilter:="All Files(*.*),*.*")
If FileToOpen <> False Then
Set copy_wb = Application.Workbooks.Open(FileToOpen)
Set paste_wb = Application.Workbooks.Open(FileToPaste)

copy_wb.Worksheets("Sheet1").Range("h29").Copy
paste_wb.Worksheets("Sheet2").Range("d27").PasteSpecial Paste:=xlPasteValues

copy_wb.Worksheets("Sheet1").Range("i29").Copy
paste_wb.Worksheets("Sheet2").Range("d28").PasteSpecial Paste:=xlPasteValues

copy_wb.Worksheets("Sheet1").Range("j29").Copy
paste_wb.Worksheets("Sheet2").Range("d29").PasteSpecial Paste:=xlPasteValues

end if
Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

would changing it to this work?

copy_wb.Worksheets("Sheet1").Range("h29:s29").Copy
paste_wb.Worksheets("Sheet2").Range("d27").PasteSpecial Paste:=xlPasteValues

or is there additional needed?

 

[johnnyL]

How about:

Sub Get_data()
'
    Dim FileToOpen          As Variant
    Dim FileToPaste         As Variant
    Dim TmpArray()          As Variant
    Dim SourceRange         As Range
    Dim DestinationRange    As Range
'
    Application.ScreenUpdating = False
'
    FileToOpen = Application.GetOpenFilename(Title:="                                                                                " & _
    "Browse for File To Copy Data From", FileFilter:="All Files(*.*),*.*")  ' open workbook
    If FileToOpen = False Then Exit Sub
'
    FileToPaste = Application.GetOpenFilename(Title:="                                                                                " & _
    "Browse for File To Paste Data To", FileFilter:="All Files(*.*),*.*")  ' open workbook
    If FileToPaste = False Then Exit Sub
'
    Set copy_wb = Application.Workbooks.Open(FileToOpen)
    Set paste_wb = Application.Workbooks.Open(FileToPaste)
'
    Set SourceRange = copy_wb.Worksheets("Sheet1").Range("H29:S29")
    Set DestinationRange = paste_wb.Worksheets("Sheet2").Range("D27")
'
    TmpArray = Application.Transpose(SourceRange.Value)
    DestinationRange.Resize(SourceRange.Columns.Count, SourceRange.Rows.Count).Value = TmpArray
'
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

You would have to close/save what you want after that point.