Выбрать дату в календареВыбрать дату в календаре

Страницы: 1
Макрос копирования данных
 
Помогите подправить код макроса чтобы копировал не все данные таблицы а только часть файла XLS диапазона ячеек A1:G1000.  
Код прилагается:  
 
Sub UnzipAFile()  
Dim ShellApp As Object  
Dim TargetFile, ZipFolder  
Dim f As String  
Application.ScreenUpdating = False  
 
'   Öåëåâîé ôàéë è âðåìåííûé êàòàëîã  
TargetFile = "C:\cot_report\dea_com_xls_2012.zip"  
ZipFolder = "C:\cot_report\Unzipped\"  
 
'   Ñîçäàíèå âðåìåííîé ïàïêè  
On Error Resume Next  
RmDir ZipFolder  
MkDir ZipFolder  
On Error GoTo 0  
 
'   Êîïèðîâàíèå àðõèâèðîâàííûõ ôàéëîâ â ñîçäàííóþ ïàïêó  
Set ShellApp = CreateObject("Shell.Application")  
ShellApp.Namespace(ZipFolder).CopyHere _  
       ShellApp.Namespace(TargetFile).items  
 
'If MsgBox("Ôàéë ðàçàðõèâèðîâàí â:" & _  
vbNewLine & ZipFolder & vbNewLine & vbNewLine & _  
"Ïðîñìîòðåòü ïàïêó?", vbQuestion + vbYesNo) = vbYes Then _  
Shell "Explorer.exe /e," & ZipFolder, vbNormalFocus  
 
If MsgBox("Ôàéë ðàçàðõèâèðîâàí â:" & vbNewLine & ZipFolder & vbNewLine & vbNewLine & _  
         "Ïîëó÷èòü äàííûå èç ôàéëà?", vbQuestion + vbYesNo) = vbYes Then _  
         f = Dir(ZipFolder & "*.xls", vbNormal)  
           
With GetObject(ZipFolder & f)  
   .Sheets(1).UsedRange.Copy Sheets("XLS").Range("A1")  
   .Close (False)  
End With  
Application.ScreenUpdating = True  
End Sub
Страницы: 1
Наверх