Aktarmada çift referans

[aydgur]

Aktarma makrosu ile sayfadan sayfaya ve sayfa adlarına göre aktarma yapılıyor.ek olarak sayfa adı değilde başka bir hücre referans alınarak aynı makro ile aktarma yapılabilirmi?

 

[karadami]

mumkun olmasi muhtemeldir. ornek bir dosya ekleyerek istediginiz sorunun cevabini daha rahat alabilirsiniz...

 

[aydgur]

Sub Aktaryeni2008erol()
SonSatir = Sheets("İMALAT").[A65536].End(3).Row + 1
Sheets("ANASAYFA").Range("A2:BL80").Copy Sheets("İMALAT").Range("A" & SonSatir)
Call sonerolaktarmaimalatlı5
End Sub
Sub sonerolaktarmaimalatlı5()
Sheets("ANASAYFA").Select
For x = 2 To [A65536].End(3).Row
Set s2 = Sheets(Cells(x, 1).Text)
sira = s2.[A65536].End(3).Row + 1
Select Case s2.Name
Case Else:
For y = 1 To 9
s2.Cells(sira, y) = Cells(x, y + 1)
Next y
End Select
Next x
Sheets("ANASAYFA").Select
Range("A2:H80").ClearContents
Range("J2:BO80").ClearContents
Sheets("ANASAYFA").Select
Range("B2:B80").Value = CDate(Format((Date + 1), "dd.mm.yyyy"))
MsgBox ("AKTARIM TAMAMLANDI")
End Sub
Bu iki makroyu peşpeşe kullanıyorum(dosyayı küçültüp yolayamadım)
A sütunundaki Sayfa adlarına aktarma yapılıyor,fakat ben aynı zamanda F sütununda ÇEK yazıyorsa;ANASAYFA daki L den R ye sütunlardaki bilgiyi ÇEK sayfasına ilk boş satırdan itibaren C sütundan başlayarak aktarsın istiyorum,umarım anlatabildim .

 

[talatcd]

Dosya ekte olsa daha iyi olurdu tam anlayamadım ama böyle bir kod işini görür inşallah.


Private Sub CommandButton1_Click()
Set s1 = Sheets("ANASAYFA")
Set s2 = Sheets("İMALAT")
s1.Select
a = Array(12,13,14,15,16,17)
sat = 1
For X = 1 To [A65536].End(3).Row
If Cells(X, 9) = "ÇEK" Then
sat = sat + 1
For y = 1 To 6
s2.Cells(sat, y) = s1.Cells(X, a(y - 1))

 

[aydgur]

Teşekkür ederim , ben Case Else yerine (yani sayfa adı yerine ANASAYFA daki F sütununda ÇEK yazıyorsa Çek sayfasına atsın istiyorum