Saya perlu menambahkan lembar Excel di akhir lembar saat ini nomor 3. Namun, ketika saya menjalankan program di bawah ini, saya mendapatkan lembar di posisi pertama. Bagaimana saya bisa mengatasi ini?
Program ini pada dasarnya menyalin data dari satu buku kerja Excel ke buku kerja lainnya, yang terdiri dari beberapa lembar.
Kode:
Dim objXL,objWrkBk,objWrkSht,a,n
Set objfso=CreateObject("Scripting.FileSystemObject")
Set objXL=CreateObject("Excel.Application")
Set objWrkBk=objXL.Workbooks.Open("C:\learning\demo.xlsx")
m=objWrkBk.Worksheets.count
msgbox m
For n=1 to m
Set objWrkBk=objXL.Workbooks.Open("C:\learning\demo.xlsx")
Set objWrkSht=objWrkBk.Worksheets("Sheet"&n)
columncount = objWrkSht.usedrange.columns.count
rowcount = objWrkSht.usedrange.rows.count
For i=1 to rowcount
For j=1 to columncount
If objWrkSht.cells(i,j).value <> "" Then
a= objWrkSht.cells(i,j).value& " "
End If
'Next
'Next
check=objfso.FileExists("C:\learning\demo1.xlsx")
If not check Then
objXL.Workbooks.Add
objXL.ActiveWorkbook.SaveAs("C:\learning\demo1.xlsx")
End If
Set objWrkBk1=objXL.Workbooks.Open("C:\learning\demo1.xlsx")
If n<=3 Then
Set objWrkSht1=objWrkBk1.Worksheets("Sheet"&n)
End If
If n>3 Then
objXL.Worksheets.add
Set objWrkSht1=objWrkBk1.Worksheets("Sheet"&n)
End If
If objWrkSht.cells(i,j).value <> "" Then
objWrkSht1.cells(i,j).value=a
objWrkBk1.Save
End If
Next
Next
Set objWrkSht=Nothing
Set objWrkBk=Nothing
Set objWrkSht1=Nothing
Set objWrkBk1=Nothing
Next
objXL.Quit
Set objXL=Nothing
