Soru Kod Düzeltme Hakkında...

[yesimgurol]

Merhabalar,
Örnek uygulamalardan bakarak kendi dosyama almış olduğum kodlar üzerinde takıldığım bir kısım var. Bulmuş olduğum kodlar ile,
1- Bilgisayarımda bulunan herhangi bir excel dosyasını seçiyorum,
2- Seçmiş olduğum excel dosyası içindeki "Sayfa1 (Sheet)" isimli sayfayı kopyalıyorum,
3- Kodu çalıştırdığım excel çalışma sayfasına "Sheet" ismiyle alıyorum.

Takıldığım / yapamadığım kısım ise ;
3.madde de yer alan sayfa ismi "HAM VERI" olarak geçsin istemekteyim.:-(

Kodlar aşağıdaki şekildedir.

Sub Düğme3_Tıkla()

Dim sImportFile As String, sFile As String
Dim sThisBk As Workbook
Dim vfilename As Variant
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set sThisBk = ActiveWorkbook
sImportFile = Application.GetOpenFilename( _
FileFilter:="Microsoft Excel Workbooks, *.xls; *.xlsx", Title:="Open Workbook")
If sImportFile = "False" Then
MsgBox "No File Selected!"
Exit Sub

Else
vfilename = Split(sImportFile, "\")
sFile = vfilename(UBound(vfilename))
Application.Workbooks.Open fileName:=sImportFile

Set wbBk = Workbooks(sFile)
With wbBk
If SheetExists("Sheet") Then
Set wsSht = .Sheets("Sheet")
wsSht.Copy before:=sThisBk.Sheets("Sayfa1")
Else
MsgBox "There is no sheet with name :Raw_Data in:" & vbCr & .Name
End If
wbBk.Close SaveChanges:=False
End With
End If
Sheets("Sayfa1").Activate
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Private Function SheetExists(sWSName As String) As Boolean
Dim ws As Worksheet
On Error Resume Next
Set ws = Worksheets(sWSName)
If Not ws Is Nothing Then SheetExists = True
End Function

 

[EmrExcel16]

Merhaba,
wsSht.Copy before:=sThisBk.Sheets("Sayfa1") Şu satırın altına

ActiveSheet.Name = "HAM VERI"

şu satırı ekleyip dener misiniz.

 

[yesimgurol]

Merhaba,
wsSht.Copy before:=sThisBk.Sheets("Sayfa1") Şu satırın altına

ActiveSheet.Name = "HAM VERI"

şu satırı ekleyip dener misiniz.

Çok teşekkür ederim , Sayın EmrExcel16...İstediğim gibi oldu.

 

[EmrExcel16]

Çok teşekkür ederim , Sayın EmrExcel16...İstediğim gibi oldu.

Rica ederim , iyi çalışmalar.