-
DİKKAT DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Aktarma ? Yardim
- Konbuyu başlatan tokerx22
- Başlangıç tarihi
- Katılım
- 1 Mart 2005
- Mesajlar
- 22,254
- Excel Vers. ve Dili
-
Win7 Home Basic TR 64 Bit
Ofis-2010-TR 32 Bit
En sona yeni bir sayfa oluştrun.
Ve son sayfada iken aşağıdaki kodu çalıştırın.
Not önce dosyanızın bir yedeğini çıkarmayı unutmayın.
Ve son sayfada iken aşağıdaki kodu çalıştırın.
Not önce dosyanızın bir yedeğini çıkarmayı unutmayın.
Kod:
Sub aktar()
Application.ScreenUpdating = False
Range("A1:F65536").ClearContents
sat = 1
For i = 2 To 1000
Sheets(i).Range("A1:F9").Copy Range("A" & sat)
sat = sat + 9
Next i
Application.ScreenUpdating = true
Application.CutCopyMode = False
MsgBox "İşlem tamam"
End Sub
S
Skorpiyon
Misafir
Sayın tokerx22,
Herhangi bir sayfaya buton koyarak, aşağıdaki kodları butona bağlayın.
Sub aktar()
Application.ScreenUpdating = False
If Sheets(1).Name <> "Aktarılan" Then
Worksheets.Add.Name = "Aktarılan"
Worksheets("Aktarılan").Move before:=Worksheets("ANASAYFA")
Else
Sheets("Aktarılan").Select
Cells.ClearContents
End If
a = Worksheets.Count
For b = 4 To a - 1
[A65536].End(xlUp).Offset(1, 0).Select
Sheets(b).Range("A1:F9").Copy
ActiveSheet.PasteSpecial
Next b
Application.ScreenUpdating = True
Range("A1").Select
End Sub
Herhangi bir sayfaya buton koyarak, aşağıdaki kodları butona bağlayın.
Sub aktar()
Application.ScreenUpdating = False
If Sheets(1).Name <> "Aktarılan" Then
Worksheets.Add.Name = "Aktarılan"
Worksheets("Aktarılan").Move before:=Worksheets("ANASAYFA")
Else
Sheets("Aktarılan").Select
Cells.ClearContents
End If
a = Worksheets.Count
For b = 4 To a - 1
[A65536].End(xlUp).Offset(1, 0).Select
Sheets(b).Range("A1:F9").Copy
ActiveSheet.PasteSpecial
Next b
Application.ScreenUpdating = True
Range("A1").Select
End Sub
Son düzenleme:
olmuyo ya
ben kafayı yemek uzerıyımmm herseyı denedım yazdır komutunda verılerı yazarken hepsı oluyo ama tek tek sayfalara yazıyo bu da 1000 sayfa gıtmesı demek o onun ıcın olmuyoo aktar cok ıyı olduydu ama bundada verılerı aktarma yaparkaen almıyo hepsını bos goruyoo yardım edersenız tesekurler walla ben kafayı yedım hayırlı gunler
cok dosya gonderdım ama baska gondermıcem bunu yapa bılırsenız sız koyun ben alıyımm ......dosyayı sız ekleyınnn
ben kafayı yemek uzerıyımmm herseyı denedım yazdır komutunda verılerı yazarken hepsı oluyo ama tek tek sayfalara yazıyo bu da 1000 sayfa gıtmesı demek o onun ıcın olmuyoo aktar cok ıyı olduydu ama bundada verılerı aktarma yaparkaen almıyo hepsını bos goruyoo yardım edersenız tesekurler walla ben kafayı yedım hayırlı gunler
cok dosya gonderdım ama baska gondermıcem bunu yapa bılırsenız sız koyun ben alıyımm ......dosyayı sız ekleyınnn
Son düzenleme:
S
Skorpiyon
Misafir
Kodları aşağıdakiler ile değiştirin.
Sub aktar()
Application.ScreenUpdating = False
If Sheets(1).Name <> "Aktarılan" Then
Worksheets.Add.Name = "Aktarılan"
Worksheets("Aktarılan").Move before:=Worksheets("ANASAYFA")
Else
Sheets("Aktarılan").Select
Cells.Delete
End If
a = Worksheets.Count
For b = 4 To a - 1
[C65536].End(xlUp).Offset(0, -2).Select
Sheets(b).Range("A1:F9").Copy
ActiveSheet.PasteSpecial
Next b
Application.ScreenUpdating = True
Range("A1").Select
MsgBox "Aktarma Tamam"
End Sub
Son düzenleme:
Kardes Olmuyor
SAYFAYI AKTARMADA SORUN YOK AMA HESAPLARA DEGER GIRDIGIM ZAMAN AKTARMADA GORUNMUYO
S
Skorpiyon
Misafir
8 Nolu mesajda kodları düzelterek tekrar verdim. O kodları kullanarak deneyin.
Denedim
bunları yenı bır dosya acıp hepsını tek tek denedımm hepsındede calsıtı ama sorun nerde pekı bunu anlayamadım yaptıgım dosya aslında cok basıtıı ama cıktı almakta cok zorlanıyorum bu sekılde cok basıt olcanıdusundum ama aktarma yaparken herseyı alıyoo hesap yapılan yerlerı almıyoo
arkadaslar vermiş oldugunuz kodların hepsi calısıyo hepınıze gercekten cok tesekur ederım basınızı baya agrıtımmŞaban Sertkaya;294619' Alıntı:
bunları yenı bır dosya acıp hepsını tek tek denedımm hepsındede calsıtı ama sorun nerde pekı bunu anlayamadım yaptıgım dosya aslında cok basıtıı ama cıktı almakta cok zorlanıyorum bu sekılde cok basıt olcanıdusundum ama aktarma yaparken herseyı alıyoo hesap yapılan yerlerı almıyoo
Son düzenleme:
S
Skorpiyon
Misafir
demiştiniz. A1-F9 arasını istediğiniz şekilde başka bir sayfaya aldırıyoruz. Sizin asıl istediğniz ne ? Sayfaların hepsini 1 defada yazdırmak mı ?
Sut Takİ P
BENIM ISTEDIGIM HEPSINI ALT ALTA YAZDIRMAK ISTIYORUM ....
YAZDIR MARKOLARINDA YALINIZ SADECE BİR SAYFAYA 1 LISTE YAZIYOR BUDA 1000 SAYFAYA ES DEGER GELIYO BEN BU SEKLILDE OLURSA ENAZ BIR SAYFAYA 10 KISI YAZDIRA BILIYORUMM BU SEKILDE 100 SAYFAYA YADA DAHA AZ SAYFA HARCYARAK BU İŞİ BITIRE BILIRIM
...SAYGILAR..
ARKADASLAR DOSYAYI EKE KOYDUM MARKODAN AKTAR DEDIGIM ZAMAN CIKAN SAYFAYA BİR BAKIN MUSTERI ADI SOYADI KOYU VE HESAPLARDAKI YAPILAN DEGİŞİKLİKLER AKTARILAN YERDE GOZUKMUYOR ..
BENIM ISTEDIGIM HEPSINI ALT ALTA YAZDIRMAK ISTIYORUM ....
YAZDIR MARKOLARINDA YALINIZ SADECE BİR SAYFAYA 1 LISTE YAZIYOR BUDA 1000 SAYFAYA ES DEGER GELIYO BEN BU SEKLILDE OLURSA ENAZ BIR SAYFAYA 10 KISI YAZDIRA BILIYORUMM BU SEKILDE 100 SAYFAYA YADA DAHA AZ SAYFA HARCYARAK BU İŞİ BITIRE BILIRIM
...SAYGILAR..
Son düzenleme:
S
Skorpiyon
Misafir
Sayın tekorx22,
Dosyayı ekleyememişsiniz.
Dosyayı ekleyememişsiniz.
arkadaşım dosya burda dosyayı ben gönderiyorum düzeltirseniz sevinirim
Son düzenleme:
S
Skorpiyon
Misafir
Sayın nerox77,
Aşağıdaki kodu kullanın.
Ben Süt Hesapları sayfasında "Fahri Karabacak" ismine tıklayıpta ilgili sayfaya geçtiğimde, A1 ve B1 hücrelerinde formül olmadığından 0 (Sıfır) değerini gördüm.
Aktarma işleminden sonra,
"Aktarılan" isimli sayfada Ctrl + F tuşları ile "Çomaklı" diye aratırsanız verinin gelmiş olduğunu görürsünüz. Diğer isim ve adreslerin çıkmaması sizin ilgili sayfalarda A1 ve B1 hücrelerine formül yazmamanızdan kaynaklanıyor.
Kullanabileceğiniz kod,
Sub aktar()
Application.ScreenUpdating = False
If Sheets(1).Name <> "Aktarılan" Then
Worksheets.Add.Name = "Aktarılan"
Worksheets("Aktarılan").Move before:=Worksheets("ANASAYFA")
Else
Sheets("Aktarılan").Select
Cells.Delete
End If
a = Worksheets.Count
For b = 4 To a - 1
[C65536].End(xlUp).Offset(0, -2).Select
Sheets(b).Range("A1:F9").Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Next b
Application.ScreenUpdating = True
Range("A1").Select
MsgBox "Aktarma Tamam"
End Sub
Aşağıdaki kodu kullanın.
Ben Süt Hesapları sayfasında "Fahri Karabacak" ismine tıklayıpta ilgili sayfaya geçtiğimde, A1 ve B1 hücrelerinde formül olmadığından 0 (Sıfır) değerini gördüm.
Aktarma işleminden sonra,
"Aktarılan" isimli sayfada Ctrl + F tuşları ile "Çomaklı" diye aratırsanız verinin gelmiş olduğunu görürsünüz. Diğer isim ve adreslerin çıkmaması sizin ilgili sayfalarda A1 ve B1 hücrelerine formül yazmamanızdan kaynaklanıyor.
Kullanabileceğiniz kod,
Sub aktar()
Application.ScreenUpdating = False
If Sheets(1).Name <> "Aktarılan" Then
Worksheets.Add.Name = "Aktarılan"
Worksheets("Aktarılan").Move before:=Worksheets("ANASAYFA")
Else
Sheets("Aktarılan").Select
Cells.Delete
End If
a = Worksheets.Count
For b = 4 To a - 1
[C65536].End(xlUp).Offset(0, -2).Select
Sheets(b).Range("A1:F9").Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Next b
Application.ScreenUpdating = True
Range("A1").Select
MsgBox "Aktarma Tamam"
End Sub
Ayhan Ercan
Özel Üye
- Katılım
- 10 Ağustos 2005
- Mesajlar
- 1,571
- Excel Vers. ve Dili
- Microsoft 365- Türkçe
Merhaba
Dosyanızdaki mevcut "aktar" makrosunu aşağıdaki ile değiştirerek deneyiniz..
Dosyanızdaki mevcut "aktar" makrosunu aşağıdaki ile değiştirerek deneyiniz..
Kod:
Sub aktar()
Application.ScreenUpdating = False
Range("A1:F65536").ClearContents
sat = 1
[COLOR=red]For i = 1 To 11
Sheets(i).Range("A1:G9").Copy
Range("A" & sat & ":G" & sat + 9).PasteSpecial Paste:=xlPasteValues
sat = sat + 12
Next i
[/COLOR]Application.ScreenUpdating = True
Application.CutCopyMode = False
MsgBox "İşlem tamam"
End SubArkadaŞim Hesabin Tamamini Nİye GÖstermİyor Çerceve İÇİnde İsİmler Rakamlar Toplam AlacaĞi ......ben KİŞİnİn Hesabini Aynen Yazdirmak İstİyorum Alt Alta ...