Copying ranges from a folder on desktop

E

ExcelRoy

Well-known Member
Joined
Oct 2, 2006
Messages
2,540
Office Version
  1. 365
Platform
  1. Windows
Hi all,

I am looking for what i think will be code in order to copy ranges from every spreadsheet inside a folder in my desktop

the folder is called PL and every "Work In Progress" job will be put into this folder, so the amount can vary from time to time

Hopefully if it is possible i need the code to open each spreadsheet in turn and copy ranges BQ16:CB317 pasting them as values only starting from B6, if any blank rows are found ( There will always be some blank rows ) delete them then leave a blank row then copy the next spreadsheet

Not sure how complicated this may get but it will act as a report that will be vital to my days work

Many thanks for any help at all
 
Sort by date Sort by votes
Could you email me an example work book that you are copying from? I can private message you my address if that would work.
 
Upvote 0

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)
Hi Chris,

I have sen the example to you and also the report where the data will be copied to

Many thanks
 
Upvote 0
Ok, well seeing the file helped me figure out what was going wrong. Since all your blanks are at the end of the data range my little trick to use the SpecialCells wasn't working. Instead I created a loop to cycle through until a blank cell is found in the first column of what was pasted over. See if that gets you closer!

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> LoopAllExcelFilesInFolder()<br><br><SPAN style="color:#007F00">'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them</SPAN><br><SPAN style="color:#007F00">'SOURCE: www.TheSpreadsheetGuru.com</SPAN><br><br><SPAN style="color:#00007F">Dim</SPAN> wb <SPAN style="color:#00007F">As</SPAN> Workbook<br><SPAN style="color:#00007F">Dim</SPAN> myPath <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN><br><SPAN style="color:#00007F">Dim</SPAN> myFile <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN><br><SPAN style="color:#00007F">Dim</SPAN> myExtension <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN><br><SPAN style="color:#00007F">Dim</SPAN> FldrPicker <SPAN style="color:#00007F">As</SPAN> FileDialog<br><SPAN style="color:#00007F">Dim</SPAN> rng <SPAN style="color:#00007F">As</SPAN> Range<br><br><SPAN style="color:#007F00">'Optimize Macro Speed</SPAN><br>  Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br>  Application.EnableEvents = <SPAN style="color:#00007F">False</SPAN><br>  Application.Calculation = xlCalculationManual<br><br><SPAN style="color:#007F00">'Target Folder Path</SPAN><br>  myPath = "C:\Users\Neil Holmes\Desktop\a\"<br><br><SPAN style="color:#007F00">'Target File Extension (must include wildcard "*")</SPAN><br>  myExtension = "*.xls"<br><br><SPAN style="color:#007F00">'Target Path with Ending Extention</SPAN><br>  myFile = Dir(myPath & myExtension)<br><br><SPAN style="color:#007F00">'Loop through each Excel file in folder</SPAN><br><br><SPAN style="color:#00007F">Set</SPAN> rng = ThisWorkbook.Sheets("Sheet1").Range("B5")<br>x = 0<br><br>  <SPAN style="color:#00007F">Do</SPAN> <SPAN style="color:#00007F">While</SPAN> myFile <> ""<br>    <SPAN style="color:#007F00">'Set variable equal to opened workbook</SPAN><br>      <SPAN style="color:#00007F">Set</SPAN> wb = Workbooks.Open(Filename:=myPath & myFile)<br>    <br>      wb.Worksheets(1).Range("BQ16:CB317").Copy<br>      rng.Offset(x + 1).PasteSpecial xlPasteValues<br>      <SPAN style="color:#00007F">Set</SPAN> rng = Selection<br>      <br>      <SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> cell <SPAN style="color:#00007F">In</SPAN> rng.Columns(1).Cells<br>        <SPAN style="color:#00007F">If</SPAN> cell.Value = "" <SPAN style="color:#00007F">Then</SPAN><br>          RowLength = cell.Row<br>          <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">For</SPAN><br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>      <SPAN style="color:#00007F">Next</SPAN> cell<br>    <br>      x = RowLength<br>                   <br>    <SPAN style="color:#007F00">'Save and Close Workbook</SPAN><br>      wb.Close SaveChanges:=<SPAN style="color:#00007F">False</SPAN><br><br>    <SPAN style="color:#007F00">'Get next file name</SPAN><br>      myFile = Dir<br>  <SPAN style="color:#00007F">Loop</SPAN><br><br><SPAN style="color:#007F00">'Message Box when tasks are completed</SPAN><br>  MsgBox "Task Complete!"<br><br><SPAN style="color:#007F00">'Reset Macro Optimization Settings</SPAN><br>  Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN><br>  Application.EnableEvents = <SPAN style="color:#00007F">True</SPAN><br>  Application.Calculation = xlCalculationAutomatic<br><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>
 
Upvote 0
Hi Chris,

Thanks for your time in trying to help me, but i cannot get it to work

It asks about data on the clipboard then throws an error on the paste values line?

Thanks
 
Upvote 0
Hmmm...I thought I had it working on my end. Maybe try this modification:

<font face=Calibri><SPAN style="color:#00007F">Sub</SPAN> LoopAllExcelFilesInFolder()<br><br><SPAN style="color:#007F00">'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them</SPAN><br><SPAN style="color:#007F00">'SOURCE: www.TheSpreadsheetGuru.com</SPAN><br><br><SPAN style="color:#00007F">Dim</SPAN> wb <SPAN style="color:#00007F">As</SPAN> Workbook<br><SPAN style="color:#00007F">Dim</SPAN> myPath <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN><br><SPAN style="color:#00007F">Dim</SPAN> myFile <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN><br><SPAN style="color:#00007F">Dim</SPAN> myExtension <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN><br><SPAN style="color:#00007F">Dim</SPAN> FldrPicker <SPAN style="color:#00007F">As</SPAN> FileDialog<br><SPAN style="color:#00007F">Dim</SPAN> rng <SPAN style="color:#00007F">As</SPAN> Range<br><br><SPAN style="color:#007F00">'Optimize Macro Speed</SPAN><br>  Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br>  Application.EnableEvents = <SPAN style="color:#00007F">False</SPAN><br>  Application.Calculation = xlCalculationManual<br><br><SPAN style="color:#007F00">'Target Folder Path</SPAN><br>  myPath = "C:\Users\Neil Holmes\Desktop\a\"<br><br><SPAN style="color:#007F00">'Target File Extension (must include wildcard "*")</SPAN><br>  myExtension = "*.xls"<br><br><SPAN style="color:#007F00">'Target Path with Ending Extention</SPAN><br>  myFile = Dir(myPath & myExtension)<br><br><SPAN style="color:#007F00">'Loop through each Excel file in folder</SPAN><br><br><SPAN style="color:#00007F">Set</SPAN> rng = ThisWorkbook.Sheets("Sheet1").Range("B5")<br>x = 0<br><br>  <SPAN style="color:#00007F">Do</SPAN> <SPAN style="color:#00007F">While</SPAN> myFile <> ""<br>    <SPAN style="color:#007F00">'Set variable equal to opened workbook</SPAN><br>      <SPAN style="color:#00007F">Set</SPAN> wb = Workbooks.Open(Filename:=myPath & myFile)<br>      <br>      wb.Worksheets(1).Range("BQ16:CB317").Copy<br>      ThisWorkbook.Sheets("Sheet1").Activate<br>      rng.Offset(x + 1).PasteSpecial xlPasteValues<br>      Application.CutCopyMode = <SPAN style="color:#00007F">False</SPAN><br>      <SPAN style="color:#00007F">Set</SPAN> rng = Selection<br>      <br>      <SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> cell <SPAN style="color:#00007F">In</SPAN> rng.Columns(1).Cells<br>        <SPAN style="color:#00007F">If</SPAN> cell.Value = "" <SPAN style="color:#00007F">Then</SPAN><br>          RowLength = cell.Row<br>          <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">For</SPAN><br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>      <SPAN style="color:#00007F">Next</SPAN> cell<br>    <br>      x = RowLength<br>                   <br>    <SPAN style="color:#007F00">'Save and Close Workbook</SPAN><br>      wb.Close SaveChanges:=<SPAN style="color:#00007F">False</SPAN><br><br>    <SPAN style="color:#007F00">'Get next file name</SPAN><br>      myFile = Dir<br>  <SPAN style="color:#00007F">Loop</SPAN><br><br><SPAN style="color:#007F00">'Message Box when tasks are completed</SPAN><br>  MsgBox "Task Complete!"<br><br><SPAN style="color:#007F00">'Reset Macro Optimization Settings</SPAN><br>  Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN><br>  Application.EnableEvents = <SPAN style="color:#00007F">True</SPAN><br>  Application.Calculation = xlCalculationAutomatic<br><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>
 
Upvote 0
oooohhh yeah!

now thats working

just the blank rows deleted if that possible

Thanks again
 
Upvote 0
There are gaps of rows between each list ie 7 rows from the first the 29, then 73

Thanks
 
Upvote 0
Hi Chris,

Is there any change we can make to only leave 1 blank row inbetween copied data?

Many thanks
 
Upvote 0
Can you email me two sample workbooks so I can figure out why there is such a gap
 
Upvote 0
Hi Chris,

Sample workbooks sent

Many thanks for your help
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Solved
Copy the last sheet from file to another with ignore empty whole column
Replies
7
Views
233
mumps
mumps
T
  • Question
Loop through folder and copy data into master spreadsheet
Replies
2
Views
389
TaskMaster
T
I
  • Question
VBA - Copy Sheet from a workbook saved as a date - paste to specifically named sheet in another workbook based on the date
Replies
2
Views
425
Insurance Dave
I
G
  • Solved
Change Macro to import files from hyperlinks
2
Replies
12
Views
557
GarnesGambit
G
R
  • Question
VBA Script: Saving worksheet as CSV on MacOS
Replies
1
Views
1K
temphelp
T

Forum statistics

Threads
1,216,552
Messages
6,131,320
Members
449,644
Latest member
tbhoola

Share this page

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