[Iska]

Elizavetta, предлагаю немного другой вариант.

Сохраните код в файл с расширением .vbs:

Скрытый текст

Код:

Option Explicit

Const xlFilterCopy = 2


Dim strSourceFile

Dim objFSO

Dim objExcel
Dim objThisWorksheet
Dim objNewWorksheet

Dim objRange

Dim objDictionary
Dim arrKeys
Dim i


If WScript.Arguments.Count = 1 Then
	Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
	
	strSourceFile = objFSO.GetAbsolutePathName(WScript.Arguments.Item(0))
	
	If objFSO.FileExists(strSourceFile) Then
		Set objExcel         = WScript.CreateObject("Excel.Application")
		Set objThisWorksheet = objExcel.Workbooks.Open(strSourceFile).Worksheets.Item("исходные данные")
		
		With objThisWorksheet
			Set objDictionary = WScript.CreateObject("Scripting.Dictionary")
			
			Set objNewWorksheet = .Parent.Worksheets.Add()
			
			.UsedRange.Columns(3).Cells.AdvancedFilter xlFilterCopy, , objNewWorksheet.Cells(1), True
			
			For i = 2 To objNewWorksheet.UsedRange.Rows.Count
				objDictionary.Add objNewWorksheet.Cells(i, 1).Value, 0
			Next
			
			objExcel.DisplayAlerts = False
			objNewWorksheet.Delete
			objExcel.DisplayAlerts = True
			
			Set objNewWorksheet = Nothing
			
			
			arrKeys = objDictionary.Keys
			
			For i = UBound(arrKeys) To LBound(arrKeys) Step -1
				.UsedRange.AutoFilter 3, arrKeys(i)
				CopyRange2NewWorksheet .Parent.Worksheets.Add(, objThisWorksheet), arrKeys(i), .UsedRange
			Next
			
			objDictionary.RemoveAll
			Set objDictionary = Nothing
			
			.ShowAllData
			.AutoFilterMode = False
			
			.Select
		End With
		
		objExcel.Visible = True
		
		Set objThisWorksheet = Nothing
		Set objExcel         = Nothing
	Else
		WScript.Echo "Can't find source file [" & strSourceFile & "]."
		WScript.Quit 2
	End If
	
	Set objFSO = Nothing
Else
	WScript.Echo "Usage: cscript.exe //nologo """ & WScript.ScriptName & """ <Source file>"
	WScript.Quit 1
End If

WScript.Quit 0
'=============================================================================

'=============================================================================
Sub CopyRange2NewWorksheet(objNewWorksheet, strName, objRange)
	With objNewWorksheet
		objRange.Copy .Cells(1)
		.Name = strName
		.Columns.AutoFit
	End With
End Sub
'=============================================================================

Затем просто перетащите на него Ваш файл с Рабочей книгой Excel. Спустя некоторое время Вы должны получить эту Рабочую книгу с несколькими новыми Рабочими листами, согласно уникальных данных из третьего столбца Рабочего листа «исходные данные», наподобие:

Скрытый текст

Дальше Вы можете поступать с этой открытой Рабочей книгой по своему усмотрению.