Excel VBA - How do copy and transpose paste another sheet

0
votes

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?.

2
excelvba
So, there is an open workbook having a sheet named "Sheet1") where you need to paste from the opened workbooks? Everytime in Range("A1") overwriting the existing contents? Is really that you want? Would you like to copy at the last empty row? Or on the next column? – FaneDuru
Do you have a single such a workbook in the mentioned folder? – FaneDuru
But, is there only a single such .xls file in the mentioned folder? If not, it sounds strange to paste everything in the same cell... – FaneDuru
@FaneDuru 1.Yes,I want to paste in workbooks having a sheet named "Sheet1". 2.Now yes overwrite everytime 3.Not yet 4. the next column 5.Many file in FolderPath – Ninlawat Phuangchoke
It is a contradiction between what you marked as 2 and 4. If everything is overwrite, how to paste in the next column? I do not understand what 3 is referring at ... – FaneDuru

2 Answers

1
votes

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
0
votes

Please see if either of following two set of codes is useful to you.

  1. 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
  1. 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.