ayrı aktarma

[aydgur]

Sub sonerolaktarma()
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
For y = 1 To 9
s2.Cells(sira, y) = Cells(x, y + 1)

Next y
Next x
Sheets("ANASAYFA").Select
Range("A2:H80").ClearContents
Range("J2:J80").ClearContents
Range("B2:B80").Value = CDate(Format((Date + 1), "dd.mm.yyyy"))
10 MsgBox "CARİLERE AKTARILDI"
End Sub
Yukarıda makro ile sayfalaın adlarına göre 9 sütundaki bilgileri dağıtabiliyorum,fakat sadece İMALAT adlı sayfasına 40 sütundaki bilgileri aktarsın istiyorum acaba olabilirmi?

 

[Ferhat Pazarçevirdi]

Anlaşılmıyor ...

fakat sadece İMALAT adlı sayfasına 40 sütundaki bilgileri aktarsın istiyorum

 

[aydgur]

Sub sonerolaktarma()
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
For y = 1 To 9
s2.Cells(sira, y) = Cells(x, y + 1)

Next y
Next x
Sheets("ANASAYFA").Select
Range("A2:H80").ClearContents
Range("J2:J80").ClearContents
Range("B2:B80").Value = CDate(Format((Date + 1), "dd.mm.yyyy"))
10 MsgBox "CARİLERE AKTARILDI"
End Sub
Bu makro ile "anasayfa"daki bilgileri adını bulduğu sayfaya 9 sütundaki bilgileri aktarıyor.Beni istediğim aktarılacak sayfa adlarından biri "imalat"sayfası ise 41 sütundaki bilgileri aktarsın (diğerlerinde yine 9 sütundaki bilgiler aktarılacak)

 

[Ferhat Pazarçevirdi]

Aşağıdakini deneyin bakalım, uyacak mı?

Olmazsa bir beden büyüğünü veririz

Sub sonerolaktarma()
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
    If s2.Name <> "imalat" Then
        For y = 1 To 9
            s2.Cells(sira, y) = Cells(x, y + 1)
        Next y
    Else
        For y = 1 To 41
            s2.Cells(sira, y) = Cells(x, y + 1)
        Next y
    End If
Next x
Sheets("ANASAYFA").Select
Range("A2:H80").ClearContents
Range("J2:J80").ClearContents
Range("B2:B80").Value = CDate(Format((Date + 1), "dd.mm.yyyy"))
10 MsgBox "CARİLERE AKTARILDI"
End Sub

 

[aydgur]

Aklınıza sağlık!! 50 yaşımdan sonra excel e merak saldım.Peki "kasa" sayfasına sadece,öreneğin D,J,M sütunlarındaki bilgileri nasıl aktarabilirim?

 

[Ferhat Pazarçevirdi]

O zaman, If-Else yapısı yerine Select Case yapısını kullanalım. Siz yeni bir case daha tanımlayabilirsiniz.

Sub sonerolaktarma()
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
    
[COLOR=red]    Select Case s2.Name
           Case "imalat":
                For y = 1 To 41
                    s2.Cells(sira, y) = Cells(x, y + 1)
                Next y
    
           Case "kasa":
                    s2.Cells(sira, 1) = Cells(x, "D")
                    s2.Cells(sira, 2) = Cells(x, "J")
                    s2.Cells(sira, 3) = Cells(x, "M")
           
           Case Else:
                For y = 1 To 9
                    s2.Cells(sira, y) = Cells(x, y + 1)
                Next y
    End Select[/COLOR]
Next x
Sheets("ANASAYFA").Select
Range("A2:H80").ClearContents
Range("J2:J80").ClearContents
Range("B2:B80").Value = CDate(Format((Date + 1), "dd.mm.yyyy"))
10 MsgBox "CARİLERE AKTARILDI"
End Sub

 

[aydgur]

İhytiyor sevindi, iyi akşamlar....

 

[uguristanbul]

hocam bende 40 tan sonra basladım excele işi gucu bıraktım bunla ugrasıyorum iflas etcem wallahi

 

[aydgur]

Merhaba! ANASAYFA daki F1,F2,F3,,,devam eden hücrelerde eğer "ÇEK" yazarsa C,D,L,M,N,O,P,Q,R, sütunundaki bilgileri ,ÇEK sayfasının ilk boş satırından itibaren A,B,C,D,E,F,G,H,I,J,K hücrelerine aktarsın istiyorum,mümkünmüdür?

 

[aydgur]

Sub sonerolaktarma()
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 "imalat":
For y = 1 To 41
s2.Cells(sira, y) = Cells(x, y + 1)
Next y

Case "kasa":
s2.Cells(sira, 1) = Cells(x, "D")
s2.Cells(sira, 2) = Cells(x, "J")
s2.Cells(sira, 3) = Cells(x, "M")

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:J80").ClearContents
Range("B2:B80").Value = CDate(Format((Date + 1), "dd.mm.yyyy"))
10 MsgBox "CARİLERE AKTARILDI"
End Sub
Bu formülde aktarma yapmak için ANASAYFA nın A2 sindeki Sayfa adını referans alıyor,fakat ben eğerF 2hücresinde ÇEK yazıyorsa onu referans alıp çek sayfasına ANASAYFA nın K,L,M,N,O,P,Q,R sütunundaki bilgileri aktarsın istiyorum ,olabilirmi ?

 

[Ferhat Pazarçevirdi]

Aşağıdaki gibi bir prosedür olabilir.

Sub Deneme1()
Sheets("ANASAYFA").Select
If Sheets("ANASAYFA").Range("F2") = "ÇEK" Then
    For i = 2 To Sheets("ANSAYFA").Cells(65536, 1).End(xlUp).Row
        son = Sheets("ÇEK").Cells(65536, 1).End(xlUp).Row + 1
        For j = 1 To 8
            Sheets("ÇEK").Cells(son, j) = Sheets("ANASAYFA").Cells(i, j + 10)
        Next j
    Next i
End If
End Sub

 

[aydgur]

Teşekkür ederim.Bu makro ile ANASAYFa daki K,L,M,N,O,P.Q.R sütunlarını ÇEK sayfasınıda A dan itibaren atıyor,C den itibaren nasıl attırabiliriz.Ek olarak ta ;ANASAYFA daki B sütununuda Çek sayfasında B sütununa bu makro içinde yapabilirmiyim,şimdiden teşekkürler.
ah be ustalar bi el atsanız