• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Diğer sayfadan belirli aralıklarla veri çekme

  • Konbuyu başlatan Konbuyu başlatan caymans
  • Başlangıç tarihi Başlangıç tarihi
C

caymans

Katılım
8 Aralık 2007
Mesajlar
17
Excel Vers. ve Dili
2007
Arkadaşlar ;
Bu şekilde bir şey yaptım ama bunu daha kısa ve çoğaltma yapamazmıyım?
Bu konuda yardımcı olurmusunuz?

Şimdiden teşekkürler. Kolay gelsin...

Sub listedencekme()
'
' listedencekme Macro
' MUSTAFA SARUL
'
' Keyboard Shortcut: Ctrl+Shift+L
'
Range("F4").Select
ActiveCell.FormulaR1C1 = "=Liste!R[-2]C[-5]"
Range("F39").Select
ActiveCell.FormulaR1C1 = "=Liste!R[-36]C[-5]"
Range("F74").Select
ActiveCell.FormulaR1C1 = "=Liste!R[-70]C[-5]"
Range("F109").Select
ActiveCell.FormulaR1C1 = "=Liste!R[-104]C[-5]"
Range("F144").Select
ActiveCell.FormulaR1C1 = "=Liste!R[-138]C[-5]"
Range("F179").Select
ActiveCell.FormulaR1C1 = "=Liste!R[-172]C[-5]"
Range("F214").Select
ActiveCell.FormulaR1C1 = "=Liste!R[-206]C[-5]"
Range("F249").Select
ActiveCell.FormulaR1C1 = "=Liste!R[-240]C[-5]"
Range("F284").Select
ActiveCell.FormulaR1C1 = "=Liste!R[-274]C[-5]"
Range("F319").Select
ActiveCell.FormulaR1C1 = "=Liste!R[-308]C[-5]"
Range("F354").Select
ActiveCell.FormulaR1C1 = "=Liste!R[-342]C[-5]"
Range("F389").Select
ActiveCell.FormulaR1C1 = "=Liste!R[-376]C[-5]"
Range("F424").Select
ActiveCell.FormulaR1C1 = "=Liste!R[-410]C[-5]"
Range("F459").Select
ActiveCell.FormulaR1C1 = "=Liste!R[-444]C[-5]"
Range("F494").Select
ActiveCell.FormulaR1C1 = "=Liste!R[-478]C[-5]"
Range("F529").Select
ActiveCell.FormulaR1C1 = "=Liste!R[-512]C[-5]"
Range("F564").Select
ActiveCell.FormulaR1C1 = "=Liste!R[-546]C[-5]"
Range("F599").Select
ActiveCell.FormulaR1C1 = "=Liste!R[-580]C[-5]"
Range("F634").Select
ActiveCell.FormulaR1C1 = "=Liste!R[-614]C[-5]"
Range("F669").Select
ActiveCell.FormulaR1C1 = "=Liste!R[-648]C[-5]"
Range("F704").Select
ActiveCell.FormulaR1C1 = "=Liste!R[-682]C[-5]"
Range("F739").Select
ActiveCell.FormulaR1C1 = "=Liste!R[-716]C[-5]"
Range("F774").Select
ActiveCell.FormulaR1C1 = "=Liste!R[-750]C[-5]"
Range("F809").Select
ActiveCell.FormulaR1C1 = "=Liste!R[-784]C[-5]"
Range("F844").Select
ActiveCell.FormulaR1C1 = "=Liste!R[-818]C[-5]"
Range("F879").Select
ActiveCell.FormulaR1C1 = "=Liste!R[-852]C[-5]"
Range("F914").Select
ActiveCell.FormulaR1C1 = "=Liste!R[-886]C[-5]"
Range("F949").Select
ActiveCell.FormulaR1C1 = "=Liste!R[-920]C[-5]"
Range("F984").Select
ActiveCell.FormulaR1C1 = "=Liste!R[-954]C[-5]"
Range("1019").Select
ActiveCell.FormulaR1C1 = "=Liste!R[-988]C[-5]"
Range("F1054").Select
ActiveCell.FormulaR1C1 = "=Liste!R[-1022]C[-5]"
Range("F1089").Select
ActiveCell.FormulaR1C1 = "=Liste!R[-1056]C[-5]"
Range("F1124").Select
ActiveCell.FormulaR1C1 = "=Liste!R[-1090]C[-5]"
Range("F1159").Select
ActiveCell.FormulaR1C1 = "=Liste!R[-1124]C[-5]"
Range("F1194").Select
ActiveCell.FormulaR1C1 = "=Liste!R[-1158]C[-5]"
Range("F1229").Select
ActiveCell.FormulaR1C1 = "=Liste!R[-1192]C[-5]"
Range("F1264").Select
ActiveCell.FormulaR1C1 = "=Liste!R[-1226]C[-5]"
Range("F1299").Select
ActiveCell.FormulaR1C1 = "=Liste!R[-1260]C[-5]"
Range("F1334").Select
ActiveCell.FormulaR1C1 = "=Liste!R[-1294]C[-5]"
Range("F1369").Select
ActiveCell.FormulaR1C1 = "=Liste!R[-1328]C[-5]"
Range("F1404").Select
ActiveCell.FormulaR1C1 = "=Liste!R[-1362]C[-5]"
Range("F1439").Select
ActiveCell.FormulaR1C1 = "=Liste!R[-1396]C[-5]"
Range("F1474").Select
ActiveCell.FormulaR1C1 = "=Liste!R[-1430]C[-5]"
Range("F1509").Select
ActiveCell.FormulaR1C1 = "=Liste!R[-1464]C[-5]"
Range("F1544").Select
ActiveCell.FormulaR1C1 = "=Liste!R[-1498]C[-5]"
Range("F1579").Select
ActiveCell.FormulaR1C1 = "=Liste!R[-1532]C[-5]"
Range("F1614").Select
ActiveCell.FormulaR1C1 = "=Liste!R[-1566]C[-5]"
Range("F1649").Select
ActiveCell.FormulaR1C1 = "=Liste!R[-1600]C[-5]"
Range("F1684").Select
ActiveCell.FormulaR1C1 = "=Liste!R[-1634]C[-5]"


End Sub
 
Son düzenleme:
merhaba;
aşağıdaki kodu dener misiniz?

Sub x()
Dim alan1 As Range
Dim j
Set alan1 = Range("f4:f1684")
j = 1
For i = 1 To alan1.Cells.Count Step 35
j = -1 * (j + 1)
alan1.Cells(i).FormulaR1C1 = "=Liste!R[" & j & "]C[-5]"
j = Abs(j)
Next
End Sub
 
excel03' Alıntı:
merhaba;
aşağıdaki kodu dener misiniz?

Sub x()
Dim alan1 As Range
Dim j
Set alan1 = Range("f4:f1684")
j = 1
For i = 1 To alan1.Cells.Count Step 35
j = -1 * (j + 1)
alan1.Cells(i).FormulaR1C1 = "=Liste!R[" & j & "]C[-5]"
j = Abs(j)
Next
End Sub
Genişletmek için tıkla ...

Olmadı ekdeki dosyada deneye bilirsiniz.
 
Son düzenleme:
merhaba;
kod kullanmaya gerek kalmadı,
ekli dosyayı inceler misiniz?
 
Son düzenleme:
excel03' Alıntı:
merhaba;
kod kullanmaya gerek kalmadı,
ekli dosyayı inceler misiniz?
Genişletmek için tıkla ...

Teşekkürler değişik bir şey olmuş ama bunda tek tek çıktı ile uğraşmak zorunda kalınacak.Toplamda aslında 250 kişinin yıllık izin kağıtlarının hazırlanması olayı söz konusu.

Liste sayfasındaki verileri değişerek tek seferde bunu yapmak daha basit sanırım.
Sizin yaptığınız olay Günlük izinler için çok ideal ama Yıllık izin listem için kullanışsız.

Açıkcası bu işime tam olarak yaramaz.
 
Son düzenleme:
Merhaba,

Fikir olmaz olur mu? Ama siz sorunuzu doğrudan sormamışsınız ki.

Liste sayfasındaki tüm kişilere doğrudan izin formu dökmek istiyorsunuz sanırım.

Bu şekilde sorsaydınız sorunuz çoktan çözülürdü diye düşünüyorum.
 
Benim verdiğim örnek dosya bu değil;

Tekrar ekliyorum.(orjinal dosya)

Daha net bir şekilde sormak gerekirse ,

Bir sayfadan diğer sayfaya belirli aralıklara veri aktarmak.

Standart 35 aralıklı ( f4-f39-f74-f109 ... gb. ) olarak.

İlerleyen zamanlarda başka bir dosya için bu macro bana lazım olacak.

Düğme sistemi bana uygun bir yöntem değil .

Saygılarımla.
 
Son düzenleme:
caymans' Alıntı:
Düğme sistemi bana uygun bir yöntem değil .
Genişletmek için tıkla ...
Sub xc()
Dim alan1 As Range
Set alan1 = Sheets("YILLIK ÜCRETLİ İZİN FORMU").Range("f4:f1684")
t = -1
For i = 1 To alan1.Cells.Count Step 35
If i <> 1 Then
t = t + 1
f1 = -1 * (i - t)
Else
f1 = -1 * (i + 1)
End If
alan1.Cells(i).FormulaR1C1 = "=Liste!R[" & f1 & "]C[-5]"
f1 = Abs(f1)
Next
End Sub
 
Son düzenleme:
excel03' Alıntı:
Sub xc()
Dim alan1 As Range
Set alan1 = Sheets("YILLIK ÜCRETLİ İZİN FORMU").Range("f4:f1684")
t = -1
For i = 1 To alan1.Cells.Count Step 35
If i <> 1 Then
t = t + 1
f1 = -1 * (i - t)
Else
f1 = -1 * (i + 1)
End If
alan1.Cells(i).FormulaR1C1 = "=Liste!R[" & f1 & "]C[-5]"
f1 = Abs(f1)
Next
End Sub
Genişletmek için tıkla ...


İşte bu...

Çok teşekkürler...

Tam istediğim bu idi.

Ellerine sağlık.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst