Copy data to new workbook, find folder and save

[mikey2322]

Hi All,

In a workbook called Master.xls I have a list of folder names (i.e. C:\Folder 1, C:\Folder 2 etc.) in Column A of the first worksheet named FOLDERS. In the second worksheet named DATA I have rows of data (Rows 1 - 120).

I need a macro that opens the workbook C:\Empty.xls and then copies a row from DATA to Cell A2 of Sheet1 in Empty.xls and then saves Empty.xls as sens_par.dbf (or .xls if .dbf will not work) in the folder name of the same corresponding row in FOLDERS.

i.e. copy row 2 from DATA (Master.xls), paste in cell A2 in Sheet1 of Empty.xls, save Empty.xls as sens_par.dbf in the folder path in cell A2 of FOLDERS (Master.xls)

then

copy row 3 from DATA (Master.xls), paste in cell A2 in Sheet1 of Empty.xls, save Empty.xls as sens_par.dbf in the folder path in cell A3 of FOLDERS (Master.xls)

etc etc for 120 rows.

Any help would be greatly appreciated.

Cheers,

Mike

 

[Domenic]

With Master.xls opened, try the following macro...

<font face=Calibri><SPAN style="color:#00007F">Option</SPAN> <SPAN style="color:#00007F">Explicit</SPAN><br><br><SPAN style="color:#00007F">Sub</SPAN> test()<br><br>    <SPAN style="color:#00007F">Dim</SPAN> strSourcePath <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> strDestPath <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> strDestPathAndFile<br>    <SPAN style="color:#00007F">Dim</SPAN> wkbMaster <SPAN style="color:#00007F">As</SPAN> Workbook<br>    <SPAN style="color:#00007F">Dim</SPAN> wksFolders <SPAN style="color:#00007F">As</SPAN> Worksheet<br>    <SPAN style="color:#00007F">Dim</SPAN> wksData <SPAN style="color:#00007F">As</SPAN> Worksheet<br>    <SPAN style="color:#00007F">Dim</SPAN> wkbEmpty <SPAN style="color:#00007F">As</SPAN> Workbook<br>    <SPAN style="color:#00007F">Dim</SPAN> wksSheet1 <SPAN style="color:#00007F">As</SPAN> Worksheet<br>    <SPAN style="color:#00007F">Dim</SPAN> LastRow <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> i <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> Ans <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Integer</SPAN><br>    <br>    Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br>    <br>    <SPAN style="color:#00007F">Set</SPAN> wkbMaster = Workbooks("Master.xls")<br>    <SPAN style="color:#00007F">Set</SPAN> wksFolders = wkbMaster.Worksheets("Folders")<br>    <SPAN style="color:#00007F">Set</SPAN> wksData = wkbMaster.Worksheets("Data")<br>    <br>    strSourcePath = "C:\Users\Domenic\Desktop\Test\"<br>    <br>    <SPAN style="color:#00007F">If</SPAN> Right(strSourcePath, 1) <> "\" <SPAN style="color:#00007F">Then</SPAN> strSourcePath = strSourcePath & "\"<br>    <br>    <SPAN style="color:#00007F">Set</SPAN> wkbEmpty = Workbooks.Open(strSourcePath & "Empty.xls")<br>    <SPAN style="color:#00007F">Set</SPAN> wksSheet1 = wkbEmpty.Worksheets("Sheet1")<br>    <br>    <SPAN style="color:#00007F">With</SPAN> wksData<br>        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row<br>        <SPAN style="color:#00007F">For</SPAN> i = 2 <SPAN style="color:#00007F">To</SPAN> LastRow<br>            strDestPath = wksFolders.Cells(i, "A").Value<br>            <SPAN style="color:#00007F">If</SPAN> Right(strDestPath, 1) <> "\" <SPAN style="color:#00007F">Then</SPAN> strDestPath = strDestPath & "\"<br>            <SPAN style="color:#00007F">If</SPAN> Len(Dir(strDestPath, vbDirectory)) = 0 <SPAN style="color:#00007F">Then</SPAN><br>                Ans = MsgBox(strDestPath & " does not exist.  Skip this folder and continue?", vbQuestion + vbOKCancel)<br>                <SPAN style="color:#00007F">If</SPAN> Ans = vbOK <SPAN style="color:#00007F">Then</SPAN><br>                    <SPAN style="color:#00007F">GoTo</SPAN> Skip<br>                <SPAN style="color:#00007F">Else</SPAN><br>                    <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br>                <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>            strDestPathAndFile = strDestPath & "sens_par.xls"<br>            <SPAN style="color:#00007F">If</SPAN> Len(Dir(strDestPathAndFile)) > 0 <SPAN style="color:#00007F">Then</SPAN><br>                Ans = MsgBox("File already exists in " & strDestPath & ".  Skip this file and continue?", vbQuestion + vbOKCancel)<br>                <SPAN style="color:#00007F">If</SPAN> Ans = vbOK <SPAN style="color:#00007F">Then</SPAN><br>                    <SPAN style="color:#00007F">GoTo</SPAN> Skip<br>                <SPAN style="color:#00007F">Else</SPAN><br>                    <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br>                <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>            .Rows(i).Copy wksSheet1.Range("A2")<br>            wkbEmpty.SaveAs strDestPathAndFile, FileFormat:=-4143<br>            wksSheet1.Rows(2).ClearContents<br>Skip:<br>        <SPAN style="color:#00007F">Next</SPAN> i<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>    <br>    wkbEmpty.Close savechanges:=<SPAN style="color:#00007F">False</SPAN><br>    <br>    Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN><br>    <br>    MsgBox "Completed...", vbInformation<br>    <br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>

 

[mikey2322]

Hi Dominic,

That works brilliantly! Thank you, your a champion!

Mike