Ron de Bruin Wrote:
> Hi Sil
>
> Do you mean this
> http://www.rondebruin.nl/copy5.htm
>
> See
> http://www.rondebruin.nl/copy5.htm#workbook
>
> --
> Regards Ron de Bruin
> http://www.rondebruin.nl
>
>
> "Sil" [email protected] wrote in message
> news:[email protected]
> I would like to have a workbook with data of different persons and then
> feed
> this information to another workbook for each individual.
>
> Is this possible?-


I'm amazed by the amassed skills and knowledge on this forum, and many
of the solution examples I've come across have had me in awe.

This example though seems a little badly worked out in terms of
reliability and performance.

If using VBA, it would be much better to perform a logical test on the
cell values directly rather than autofiltering and then
copying/pasting, which uses much more resources.

Also - as I've said in another post, surrounding an instruction with
'On Error Resume Next' and 'On Error Goto 0' is very bad practice and
leads to Illegal Operation errors aplently. There are times when it's
the only way out for errors that are really impossible to predict
because they might be caused by a user's specific system setup.

However, the example here (try and delete a sheet named 'Netherlands'
but ignore the error if no such sheet exists) is well avoidable and
there is an easy systematic way not to resort to this.

Firstly, I would have just checked the value in each cell in Column 1
and, if matching the match value, write those values to the new sheet,
with ... .value = ... .value instructions (not using the clipboard at
all).

Something like:

Dim tValsListed As String
tValsListed = ""

Set xSourceSheet = ThisWorkbook.Worksheets(1)
nRows = xSourceSheet.Cells(1,1).CurrentRegion.Rows.Count
For nRow = 1 to nRows
--tMatchVal = xSourceSheet.Cells(nRow,1).Text
--If Instr(1,tValsListed,tMatchVal & "|",1) = 0 Then
----tValsListed=tValsListed & tMatchVal & "|"
----'Insert code to delete old sheets (below) if required
----ThisWorkbook.Worksheets.Add.Name = tMatchVal
--End If

--Set xDestSheet = ThisWorkbook.Worksheets(tMatchVal)
--nNewRow = xDestSheet.Cells(1,1).CurrentRegion.Rows.Count+1
--xDestSheet.Rows(nNewRow).EntireRow.Cells.Value =
_ xSourceSheet.Rows(nRow).EntireRow.Cells.Value
Next nRow

Secondly, to delete a sheet that may or may not be there (such as the
"Netherlands" example, I would have used code like this:

tSheetToDelete = tMatchVal
For Each xSheet in ThisWorkbook.Worksheets
--If xSheet.Name = tSheetToDelete Then
----xSheet.Delete
----Exit For
--End If
Next xSheet

.BizMark.


--
BizMark