Modify to Change Paste to Rows Verses Columns

Papi

Well-known Member
Joined
May 22, 2007
Messages
1,592
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.

Code:
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
 

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
This compiles ok, but I haven't tested it so mat need some tweaking:
Code:
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
 
Upvote 0
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.
 
Upvote 0
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:
Code:
Sheets(1).Cells(OutputRow, 1).PasteSpecial paste:=xlPasteFormats, transpose:=true
Sheets(1).Cells(OutputRow, 1).PasteSpecial paste:=xlPasteValues, transpose:=true
 
Upvote 0

Forum statistics

Threads
1,223,236
Messages
6,170,906
Members
452,366
Latest member
TePunaBloke

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top