Change in macro

[Roman12]

Hi,
I have received the attached macro that does exactly what I asked for, but it would actually help if somebody could make a minor change in it.

The following macro copy pastes the data into different sheets. That means: in my sheet called Data, the macro copies the data in the whole row if the word xxx is written in column C and pastes it into the sheet with the same name.

Would it be possible to copy paste the data instead of the sheet into a new Excel file? This would mean, that the data of xxx would instead of in a sheet be placed into a new Excel file with the same name.

Thank you very much for your help.


Sub ExtractData()
Dim lr As Long
Dim i As Long

mysheet = Array("www", "xxx", "yyy")
lr = Sheets("Data").Range("C" & Rows.Count).End(xlUp).Row
Application.EnableEvents = False
Application.ScreenUpdating = False
For i = 0 To UBound(mysheet)
Sheets(mysheet(i)).UsedRange.ClearContents
With Sheets("Data").Range("A1:L" & lr)
.AutoFilter Field:=3, Criteria1:=mysheet(i)
.Copy Destination:=Sheets(mysheet(i)).Range("A1")
.AutoFilter
End With
Next i
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

 

[Richard Schollar]

At the moment I get a runtime error which says, subscript out of range.

Where exactly do you get this error? Indicate on which line of code.

At the beginning, the workbook has been created, but no data has been copied in.

which workbook? Is this the workbook that contains the data that the macro will use autofilter on?

 

[Peter_SSs]

I think the relevant line near the top might need changing to:

wb.SaveAs ele & ".xls"

 

[Roman12]

Now I have taken the suggestion that Richard has sent me at the beginning. This macro does create a new sheet, but only one, and there is no data pasted from my data sheet.
I try to put in Peters line into Richards macro now and see what happens.

 

[Peter_SSs]

Also, just before the line...
Next i

... suggest adding this line:

Workbooks(mysheet(i) & ".xls").Save

 

[Roman12]

That was a great change Peter. The macro opens all the workbooks needed with the exact name on it. Unfortunately, the workbooks do not contain any data required.

 

[Peter_SSs]

That was a great change Peter. The macro opens all the workbooks needed with the exact name on it. Unfortunately, the workbooks do not contain any data required.

It worked for me. This was my original sheet:

Excel Workbook
	A	B	C	D	E	F	G	H	I	J	K	L
1	Expired	2 weeks notice	Group	id	a	aa	aaaa	aaaaa	aaa	aaaaaaa	aaa	aaaa
2			xxx	0	sdf	g
3			xxx	0	gsd	s
4			xxx	0	gfsd	dg
5			xxx	0	fgs	s
6			yyy	1	dfg	dfg
7			yyy	1	sdgf	s
8			yyy	1	s	fg
9			yyy	1	gfsd	sdf
10			yyy	1	dfg	g
11			yyy	1	s	sdf
12			yyy	1	g	dfg
13			yyy	1	s	s
14
Data

..and this was the final code I used:

<font face=Courier New><br><SPAN style="color:#00007F">Sub</SPAN> ExtractData()<br>    <SPAN style="color:#00007F">Dim</SPAN> lr <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> wb, ele<br>    <br>    mysheet = Array("www", "xxx", "yyy")<br>    <SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> ele <SPAN style="color:#00007F">In</SPAN> mysheet<br>        <SPAN style="color:#00007F">Set</SPAN> wb = Workbooks.Add(xlWBATWorksheet)<br>        wb.SaveAs ele & ".xls"<br>    <SPAN style="color:#00007F">Next</SPAN><br>    ThisWorkbook.Activate<br>    lr = Sheets("Data").Range("C" & Rows.Count).End(xlUp).Row<br>    Application.EnableEvents = <SPAN style="color:#00007F">False</SPAN><br>    Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br>    <SPAN style="color:#00007F">For</SPAN> i = 0 <SPAN style="color:#00007F">To</SPAN> <SPAN style="color:#00007F">UBound</SPAN>(mysheet)<br>        <SPAN style="color:#00007F">With</SPAN> Sheets("Data").Range("A1:L" & lr)<br>            .AutoFilter Field:=3, Criteria1:=mysheet(i)<br>            .Copy Destination:=Workbooks(mysheet(i) & ".xls").Sheets(1).Range("A1")<br>            .AutoFilter<br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>        Workbooks(mysheet(i) & ".xls").Save<br>    <SPAN style="color:#00007F">Next</SPAN> i<br>    Application.EnableEvents = <SPAN style="color:#00007F">True</SPAN><br>    Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br><br><br></FONT>

 

[Roman12]

Great it worked for me as well. Is it possible to give the sheet the same name as well? You made that yesterday. The workbook with the name xxx should also have the sheet called xxx.

 

[Peter_SSs]

Great it worked for me as well. Is it possible to give the sheet the same name as well? You made that yesterday. The workbook with the name xxx should also have the sheet called xxx.

Add the middle line below between the other two

<font face=Courier New>        <SPAN style="color:#00007F">Set</SPAN> wb = Workbooks.Add(xlWBATWorksheet)<br>        ActiveSheet.Name = ele<br>        wb.SaveAs ele & ".xls"</FONT>

 

[Roman12]

Strange. That does not work. It opens the workbooks without data again and without the right name in the sheet.

Do you know why? I only put the line into the middle as you have told me.

 

[Roman12]

If I add the suggested line, the runtime error subscript out of range appears. The rest is still working, I started again.