Excel VBA - How do copy and transpose paste another sheet - excel

Question

I try to copy data from Workbooks with Sheets("daily shift report") to another Workbooks Sheets ("Sheet1") by transpose according to the code below.
Sub copyDatafrommultipleworkbookintomaster()
Dim FolderPath As String, Filepath As String, Filename As String, Erow As Range
FolderPath = "C:\Users\YIT\Documents\test\April57\"
Filepath = FolderPath & "*.xls*"
Filename = Dir(Filepath)
Do While Filename <> ""
Workbooks.Open (FolderPath & Filename)
ActiveWorkbook.Sheets("daily shift report").Range("B71:G77").Copy
Application.DisplayAlerts = False
ActiveWorkbook.Close
Worksheets("Sheet1").Range("A1").PasteSpecial Transpose:=True
Filename = Dir
Loop
End Sub
But found Run time error '1004' Application-defined or object-defined error.I guess error in line 14.
Worksheets("Sheet1").Range("A1").PasteSpecial Transpose:=True
Could you please suggest a solution to this problem?.

Answer 1

Try the next code, please. It will Paste, from each existing .xls workbook, in the next empty column of "Sheet1":
Sub copyDatafrommultipleworkbookintomaster()
Dim FolderPath As String, Filepath As String, Filename As String
Dim wb As Workbook, ws As Worksheet, Col As Long
Col = 1
Set ws = ActiveWorkbook.Sheets("Sheet1")
FolderPath = "C:\Users\YIT\Documents\test\April57\"
Filename = Dir(FolderPath & "*.xls*")
Do While Filename <> ""
Set wb = Workbooks.Open(FolderPath & Filename)
wb.Sheets("daily shift report").Range("B71:G77").Copy
ws.cells(1, Col).PasteSpecial Paste:=xlPasteAll, Transpose:=True
Col = Col + 7 'increment the next col where to paste
wb.Close False
Filename = Dir
Loop
End Sub

Answer 2

Please see if either of following two set of codes is useful to you.
Mention your Source File Path & File name directly as string
Sub GetData()
Dim customerFilename As String
Dim customerWorkbook As Workbook
Dim targetSheet As Worksheet, sourceSheet As Worksheet
'targetSheet is Activeworkbook wherein you would want to fetch the data
Set targetSheet = ActiveWorkbook.Worksheets("Sheet1")
'Mention Source-file path & file name between double quotes below
customerFilename = "C:\Users\YIT\Documents\test\April57\Your_File_Name_Here.xls"
Set customerWorkbook = Application.Workbooks.Open(customerFilename)
Set sourceSheet = customerWorkbook.Worksheets("daily shift report")
sourceSheet.Range("B71:G77").Copy
'select in which cell you want to paste data
targetSheet.Range("A1").PasteSpecial Transpose:=True
customerWorkbook.Close
End Sub
In this code you will be prompted to select Source File (.xls or .xlsx or .csv), no need to manually write Source Filepath & Filename.
Sub GetData2()
Dim filter As String, caption As String
Dim customerFilename As String
Dim customerWorkbook As Workbook
Dim targetSheet As Worksheet, sourceSheet As Worksheet
'targetSheet is Activeworkbook wherein you would want to fetch the data
Set targetSheet = ActiveWorkbook.Worksheets("Sheet1")
'Prompt to get the customerWorkbook i.e. Source Workbook
filter = "Excel and CSV Files (*.xls;*.xlsx;*.csv),*.xls;*.xlsx;*.csv"
caption = "Please Select an input file "
customerFilename = Application.GetOpenFilename(filter, , caption)
Set customerWorkbook = Application.Workbooks.Open(customerFilename)
Set sourceSheet = customerWorkbook.Worksheets("daily shift report")
sourceSheet.Range("B71:G77").Copy
'select in which cell you want to paste data
targetSheet.Range("A1").PasteSpecial Transpose:=True
customerWorkbook.Close
End Sub
Hope these codes are useful to you. Regards.