Verİ Aktarma İle İlgİlİ

[emre1979]

Arkadaşlar yardımcı olursanız sevinirim

 

[N.Ziya Hiçdurmaz]

Yanıt

Renkli yeri ilave edip deneyiniz.

Sub SAYFA_EKLE()
   On Error GoTo Hata
    Set S1 = Sheets("Sayfa1")
    For X = 1 To S1.[A65536].End(3).Row
    If S1.Cells(X, 1) <> "" Then
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = S1.Cells(X, 1)
    End If
    Next
   [COLOR="Blue"] [A1] = ActiveSheet.Name
    [A2] = "DATUM"
    [D2] = "ANGEW. RUF-NR."
    [G2] = "ANZ. E."
    [H2] = "E.-PREİS"
    [I2] = "SUMME"
    [J2] = "DAUER"
    [K2] = "UHRZEİT"
    Range("A2,D2,G2,H2,I2,J2,K2").Interior.ColorIndex = 6[/COLOR]
    S1.Select
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
    Exit Sub
Hata:
    Application.DisplayAlerts = False
    ActiveSheet.Delete
    Application.DisplayAlerts = True
    S1.Select
    MsgBox "Aynı isimde sayfalar mevcuttur.", vbCritical, "DİKKAT !"
End Sub

 

[emre1979]

Hocam Yardiminiz İÇİn TeŞekkÜrler Fakat
Aktamalari Sadece Son Sayfaya Yapiyor

 

[emre1979]

Arkadaslar Yardimci Olursaniz Sevinirim

 

[baba_karabatak]

Sub SAYFA_EKLE()
On Error GoTo Hata
Set S1 = Sheets("Sayfa1")
For X = 1 To S1.[A65536].End(3).Row
If S1.Cells(X, 1) <> "" Then
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = S1.Cells(X, 1)
[A1] = ActiveSheet.Name
[A2] = "DATUM"
[D2] = "ANGEW. RUF-NR."
[G2] = "ANZ. E."
[H2] = "E.-PRE&#304;S"
[I2] = "SUMME"
[J2] = "DAUER"
[K2] = "UHRZE&#304;T"
Range("A2,B2,C2,D2,E2,F2,G2,H2,I2,J2,K2").Interior.ColorIndex = 6
S1.Select

End If
Next
MsgBox "&#304;&#351;leminiz tamamlanm&#305;&#351;t&#305;r.", vbInformation
Exit Sub
Hata:
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
S1.Select
MsgBox "Ayn&#305; isimde sayfalar mevcuttur.", vbCritical, "D&#304;KKAT !"
End Sub

yukardaki gibi de&#287;i&#351;tirin

 

[emre1979]

tesekkurler tam ıstedıgım gıbı olmus