Помогите подправить код макроса чтобы копировал не все данные таблицы а только часть файла 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
Код прилагается:
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