Copying ranges from a folder on desktop

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
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
Hi Chris,

Many thanks, but this macro does a little more than i need it to?

Hopefully a more simplified code would be better?

Thanks anyway
 
Upvote 0
Hi Chris,

From what i can see, i need to adapt the following line

wb.Worksheets(1).Range("A1:Z1").Interior.Color = RGB(51, 98, 174)

To actually copy ranges BQ16:CB317

then to paste them onto my report workbook starting from cell B6 making sure each of the ranges are listed after each other

Can you provide any guidance to do this?

Thanks
 
Upvote 0
Maybe try something like this (I didn't address the deleting blank rows in my solution, lets do this piece by piece)

<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">'Retrieve Target Folder Path From User</SPAN><br>  <SPAN style="color:#00007F">Set</SPAN> FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)<br><br>    <SPAN style="color:#00007F">With</SPAN> FldrPicker<br>      .Title = "Select A Target Folder"<br>      .AllowMultiSelect = <SPAN style="color:#00007F">False</SPAN><br>        <SPAN style="color:#00007F">If</SPAN> .Show <> -1 <SPAN style="color:#00007F">Then</SPAN> <SPAN style="color:#00007F">GoTo</SPAN> NextCode<br>        myPath = .SelectedItems(1) & "\"<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br><br><SPAN style="color:#007F00">'In Case of Cancel</SPAN><br>NextCode:<br>  myPath = myPath<br>  <SPAN style="color:#00007F">If</SPAN> myPath = "" <SPAN style="color:#00007F">Then</SPAN> <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN><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>    <SPAN style="color:#007F00">'Change First Worksheet's Background Fill Blue</SPAN><br>      wb.Worksheets(1).Range("BQ16:CB317").Copy<br>      rng.Offset(x + 1).PasteSpecial xlPasteValues<br>      x = x + 301<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
Hi Chris,

This is great works well for me

Could i have the file location set at always the same location

ie USERS/NAME/DESKTOP/A

Then the blank rows deleted but leaving a space inbetween each range returned

Many thanks for your help
 
Upvote 0
Try this. Make sure you update the folder path string before running. I wasn't sure what you wanted as your path.

<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/NAME/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>    <SPAN style="color:#007F00">'Change First Worksheet's Background Fill Blue</SPAN><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:#007F00">'Delete Blanks</SPAN><br>        rng.SpecialCells(xlCellTypeBlanks).EntireRow.Delete<br>        x = x + rng.Rows.Count<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,

It seems to throw up an error at this line

rng.SpecialCells(xlCellTypeBlanks).EntireRow.Delete

Thanks
 
Upvote 0
Is there a chance that there are no blanks to delete? If so you will want to resume next on an error try replacing that line with

Code:
On Error Resume Next
[COLOR=#333333]rng.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error Goto 0[/COLOR]
 
Upvote 0
Hi Chris,

There will always be blank rows although they might have formula in them but not displaying anything. But as it only copies across as values i dont suppose that matters

The error is overlapping of commands?

i have tried to delete the delete blank rows line but the same error occurs

Thanks
 
Upvote 0

Forum statistics

Threads
1,213,560
Messages
6,114,306
Members
448,564
Latest member
ED38

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