Copying ranges from a folder on desktop

[ExcelRoy]

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

 

[Chris Macro]

Ok, this should do the trick!

<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\Chris\Desktop\Testing\Neil\"<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).PasteSpecial xlPasteValues<br>      Application.CutCopyMode = <SPAN style="color:#00007F">False</SPAN><br>      <SPAN style="color:#00007F">Set</SPAN> Copiedrng = Selection<br>      <br>      <SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> cell <SPAN style="color:#00007F">In</SPAN> Copiedrng.Columns(1).Cells<br>      yy = cell.Address<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 - rng.Row + 1<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>Range("A1").Select<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>

 

[ExcelRoy]

Hi Chris,

Sorry, but nothing happens now

Just the "Task Complete" box appears

Edit:

Changed the destination folder

Perfect now, many thanks for your help

 

[Chris Macro]

oh yeah, sorry! Forgot to change the back, haha