Modify to Change Paste to Rows Verses Columns

[Papi]

I found this excellent code on this site and it works great. What do I need to do when copying from the source documents to paste the information into rows rather than columns? The first row would be Row 4 and then go down by 1 row each time until completed.

Sub FolderCrawler()

FileType = "*.xlsm*" 'The file type to search for
FilePath = "C:\Users\Alan\Documents\Sales\" 'The folder to search

Dim OutputCol As Variant
Dim Curr_File As Variant
Dim FldrWkbk As Workbook

OutputCol = 1 'The first row of the active sheet to start writing to

 ThisWorkbook.ActiveSheet.Range(Cells(3, OutputCol), Cells(3, OutputCol)) = FilePath & FileType
 OutputCol = OutputCol + 1

 Curr_File = Dir(FilePath & FileType)

 Do Until Curr_File = ""
 Set FldrWkbk = Workbooks.Open(FilePath & Curr_File, False, True) 'Open new data file
 Sheets("Order").Range("D18:D27").Copy 'Copy data from specific Range

 'Move back to Master file
 Workbooks("SUMMARY.xlsm").Activate
 Sheets(1).Cells(4, OutputCol).Select
 ActiveSheet.Paste
 OutputCol = OutputCol + 1

 FldrWkbk.Close SaveChanges:=False 'Close the data file
 Curr_File = Dir 'Select Next File
 Loop
 Set FldrWkbk = Nothing
End Sub

 

[JoeMo]

This compiles ok, but I haven't tested it so mat need some tweaking:

Sub FolderCrawler()

FileType = "*.xlsm*" 'The file type to search for
FilePath = "C:\Users\Alan\Documents\Sales\" 'The folder to search

Dim OutputRow As Variant
Dim OutputCol As Variant
Dim Curr_File As Variant
Dim FldrWkbk As Workbook

OutputCol = 1 'The first row of the active sheet to start writing to
OutputRow = 4  'First row for output
 ThisWorkbook.ActiveSheet.Range(Cells(3, OutputCol), Cells(3, OutputCol)) = FilePath & FileType
 OutputCol = OutputCol + 1

 Curr_File = Dir(FilePath & FileType)

 Do Until Curr_File = ""
 Set FldrWkbk = Workbooks.Open(FilePath & Curr_File, False, True) 'Open new data file
 Sheets("Order").Range("D18:D27").Copy 'Copy data from specific Range

 'Move back to Master file
 Workbooks("SUMMARY.xlsm").Activate
 Sheets(1).Cells(OutputRow, 1).PasteSpecial Paste:=xlPasteAll, Transpose:=True
' ActiveSheet.Paste
' OutputCol = OutputCol + 1
OutputRow = OutputRow + 1

 FldrWkbk.Close SaveChanges:=False 'Close the data file
 Curr_File = Dir 'Select Next File
 Loop
 Set FldrWkbk = Nothing
End Sub

 

[Papi]

Thank you very much Joe. It works perfectly.

 

[JoeMo]

Thank you very much Joe. It works perfectly.

You are welcome - thanks for the reply.

 

[Papi]

The code is working so well that I decided to pull a larger range of data which some have formulas. What would have to be done to replace the information with the value as opposed to the formulas and retain the formatting from the original forms? None of the information needs to be linked as it is now doing with the added range.

 

[JoeMo]

The code is working so well that I decided to pull a larger range of data which some have formulas. What would have to be done to replace the information with the value as opposed to the formulas and retain the formatting from the original forms? None of the information needs to be linked as it is now doing with the added range.

If you just want to paste values and number formats, replace:

xlPasteAll with xlPasteValuesAndNumberFormats

If there is other formatting you want to transfer as well then you can use a second pastespecial line:

Sheets(1).Cells(OutputRow, 1).PasteSpecial paste:=xlPasteFormats, transpose:=true
Sheets(1).Cells(OutputRow, 1).PasteSpecial paste:=xlPasteValues, transpose:=true

 

[Papi]

Thanks once again Joe. It works fine!

 

[JoeMo]

Thanks once again Joe. It works fine!

You are welcome - thnaks for the reply.