Mr Kid,
saya lampirkan pengubahan saya yang terakhir dan masih terhadang di paste
special.
mungkin ada ubahan makronya yg salah posisinya.
regards,
yudha
-------------------------------------------------------------
Public Sub OpenFile(strPath As String)
Dim RngRowA As Range, RngRowB As Range
Dim xcostcenterno As String, xcostcentername As String
Dim btn, rght As Long
Dim myLastRow As Long
Dim myLastColumn As Long
Dim xlApp As New Excel.Application
xlApp.Visible = False
Dim book As Excel.Workbook
Set book = xlApp.Workbooks.Open(strPath)
With book.Worksheets("SCOPE")
xcostcenterno = .Cells(1, 2).Value
End With
'create folder with name cost center
Set ws = ThisWorkbook.Worksheets.Add
ws.Name = xcostcenterno
With book.Worksheets("ACTIVITY")
'xlApp.Intersect(.UsedRange, .Range("A1", .Cells(Rows.Count,
Columns.Count))).Copy
'mencari range yang ada datanya dimulai dari cell A1 supaya judul
datanya ikut ke copy
'.UsedRange.Copy
'ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
0).PasteSpecial Paste:=xlPasteAll, _
' Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'xlApp.Intersect(.UsedRange, .Range("A1", .Cells(Rows.Count,
Columns.Count))).Copy
'mencari range yang ada datanya dimulai dari cell A1 supaya judul
datanya ikut ke copy
'.UsedRange.Copy
'ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
0).PasteSpecial Paste:=xlPasteColumnWidths, _
'Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.UsedRange.Copy ws.Range("A1")
.UsedRange.Copy
ws.Range("A1").PasteSpecial Paste:=xlPasteColumnWidths
End With
ActiveWindow.DisplayGridlines = False
ActiveWindow.Zoom = 80
book.Close savechanges:=False
'app.Quit
Set app = Nothing
End Sub
2011/9/30 Kid Mr. <[email protected]>
> **
>
>
> Setelah dicoba beberapa hal sebelumnya, hasilnya adalah tidak ada masalah
> yang timbul.
> Jika ditempat anda bermasalah, maka coba ubah blok :
>
>
> With book.Worksheets("ACTIVITY")
>
> 'xlApp.Intersect(.UsedRange, .Range("A1", .Cells(Rows.Count,
> Columns.Count))).Copy
> 'mencari range yang ada datanya dimulai dari cell A1 supaya judul
> datanya ikut ke copy
> .usedrange.copy
>
> ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
> 0).PasteSpecial Paste:=xlPasteAll, _
> Operation:=xlNone, SkipBlanks:=False, Transpose:=False
>
> 'xlApp.Intersect(.UsedRange, .Range("A1", .Cells(Rows.Count,
> Columns.Count))).Copy
> 'mencari range yang ada datanya dimulai dari cell A1 supaya judul
> datanya ikut ke copy
> .usedrange.copy
>
> ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
> 0).PasteSpecial Paste:=xlPasteColumnWidths, _
> Operation:=xlNone, SkipBlanks:=False, Transpose:=False
>
> End With
>
> menjadi :
>
> With book.Worksheets("ACTIVITY")
>
> .usedrange.copy ws.Range("A1")
>
> .usedrange.copy
> ws.Range("A1").PasteSpecial Paste:=xlPasteColumnWidths
>
> End With
>
> Bila perlu, copas script hasil pengubahan anda untuk prosedur tersebut ke
> body email.
>
>
> Kid.
>
> 2011/9/30 Yudha Saptiadi <[email protected]>
>
>> **
>>
>>
>> masih sama mr Kid..
>>
>> errornya kena disini :
>>
>>
>> ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0, 0).PasteSpecial
>> Paste:=xlPasteAll, _
>> Operation:=xlNone, SkipBlanks:=False, Transpose:=False
>>
>> Regards,
>> ys
>>
>>
>> 2011/9/30 Kid Mr. <[email protected]>
>>
>>> **
>>>
>>>
>>> Bagian :
>>>
>>> xlApp.Intersect(.UsedRange, .Range("A1", .Cells(Rows.Count,
>>> Columns.Count))).Copy
>>> Ganti dengan :
>>> .UsedRange.Copy
>>>
>>>
>>> Kid.
>>>
>>> 2011/9/30 Yudha Saptiadi <[email protected]>
>>>
>>>> **
>>>>
>>>>
>>>> Mr.Kid...
>>>> sudah di coba dua duanya tp
>>>> Masih di tendang di paste specialnya
>>>> apakah karena intersectnya juga yg harus di perbaiki makronya..??
>>>>
>>>>
>>>> 2011/9/30 Kid Mr. <[email protected]>
>>>>
>>>> **
>>>>>
>>>>>
>>>>> Bagian :
>>>>> With book.Worksheets("ACTIVITY")
>>>>>
>>>>> xlApp.Intersect(.UsedRange, .Range("A1", .Cells(Rows.Count,
>>>>> Columns.Count))).Copy
>>>>> 'mencari range yang ada datanya dimulai dari cell A1 supaya
>>>>> judul datanya ikut ke copy
>>>>>
>>>>> End With
>>>>>
>>>>> * 'create folder with name cost center
>>>>> Set ws = ThisWorkbook.Worksheets.Add
>>>>> ws.Name = xcostcenterno*
>>>>>
>>>>>
>>>>> ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
>>>>> 0).PasteSpecial Paste:=xlPasteAll, _
>>>>> Operation:=xlNone, SkipBlanks:=False, Transpose:=False
>>>>> ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
>>>>> 0).PasteSpecial Paste:=xlPasteColumnWidths, _
>>>>> Operation:=xlNone, SkipBlanks:=False, Transpose:=False
>>>>>
>>>>> Letakkan yang biru di atas With book.blah
>>>>> Menjadi :
>>>>>
>>>>> * 'create folder with name cost center
>>>>> Set ws = ThisWorkbook.Worksheets.Add
>>>>> ws.Name = xcostcenterno
>>>>>
>>>>> * With book.Worksheets("ACTIVITY")
>>>>>
>>>>> xlApp.Intersect(.UsedRange, .Range("A1", .Cells(Rows.Count,
>>>>> Columns.Count))).Copy
>>>>> 'mencari range yang ada datanya dimulai dari cell A1 supaya
>>>>> judul datanya ikut ke copy
>>>>>
>>>>> End With
>>>>>
>>>>>
>>>>>
>>>>>
>>>>> ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
>>>>> 0).PasteSpecial Paste:=xlPasteAll, _
>>>>> Operation:=xlNone, SkipBlanks:=False, Transpose:=False
>>>>> ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
>>>>> 0).PasteSpecial Paste:=xlPasteColumnWidths, _
>>>>> Operation:=xlNone, SkipBlanks:=False, Transpose:=False
>>>>>
>>>>> Jika masih error juga, ubah proses copas menjadi :
>>>>>
>>>>> With book.Worksheets("ACTIVITY")
>>>>>
>>>>> xlApp.Intersect(.UsedRange, .Range("A1", .Cells(Rows.Count,
>>>>> Columns.Count))).Copy
>>>>> 'mencari range yang ada datanya dimulai dari cell A1 supaya
>>>>> judul datanya ikut ke copy
>>>>>
>>>>> ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
>>>>> 0).PasteSpecial Paste:=xlPasteAll, _
>>>>> Operation:=xlNone, SkipBlanks:=False, Transpose:=False
>>>>>
>>>>> xlApp.Intersect(.UsedRange, .Range("A1", .Cells(Rows.Count,
>>>>> Columns.Count))).Copy
>>>>> 'mencari range yang ada datanya dimulai dari cell A1 supaya
>>>>> judul datanya ikut ke copy
>>>>>
>>>>> ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
>>>>> 0).PasteSpecial Paste:=xlPasteColumnWidths, _
>>>>> Operation:=xlNone, SkipBlanks:=False, Transpose:=False
>>>>>
>>>>> End With
>>>>>
>>>>> Regards.
>>>>> Kid.
>>>>>
>>>>>
>>>>> 2011/9/30 Yudha Saptiadi <[email protected]>
>>>>>
>>>>>> **
>>>>>>
>>>>>>
>>>>>>
>>>>>> Dear para pakar...
>>>>>>
>>>>>> mohon bantuannnya yaaa...memperbaiki macronya pada saat copy range
>>>>>> dari file lain spt terlampir.
>>>>>>
>>>>>> paste spesialnya error melulu..
>>>>>>
>>>>>> "pastespecial method of range class failed"
>>>>>>
>>>>>> Notes: untuk mengambil datanya gunakan file: __Konsolidasi Activity
>>>>>> v0.1_test.xlsm
>>>>>>
>>>>>> atas waktu dan effortnya saya ucapkan terimaksih.
>>>>>>
>>>>>>
>>>>>> regards,
>>>>>> Yudha
>>>>>>
>>>>>
>>>>>
>>>>
>>>
>>
>
>
