Veri aktar

[ormann]

Sayın arkadaşlar ekteki örnek dosyamda bulunan a sayfasındaki "b5" hücresi ile b30" hücrelerini ,"b" sayfasındaki a5 hücresinden başlayarak sırasıyla aktarması ve her veri aktar dediğimizde ise aktarılan sayfaya o sutunlar arasında ki hücreleri tablo şekline alması.böyle birşey yapılabilirmi yardımlarınızı bekliyorum.

 

[Huseyinkis]

Sayın arkadaşlar ekteki örnek dosyamda bulunan a sayfasındaki "b5" hücresi ile b30" hücrelerini ,"b" sayfasındaki a5 hücresinden başlayarak sırasıyla aktarması ve her veri aktar dediğimizde ise aktarılan sayfaya o sutunlar arasında ki hücreleri tablo şekline alması.böyle birşey yapılabilirmi yardımlarınızı bekliyorum.

Merhaba Ektki kodları incelermisiniz.

Sub Aktar()
Sheets("A").Select
Range("B5:B22").Select
Selection.Copy
Sheets("B").Select
sonsat = Sheets("B").Range("A65536").end(3).Row + 1
Cells(sonsat, "A").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
End Sub

 

[ormann]

Sayın hüseyin aktarma işlemi olmuş acaba akaraılan sayfada aktarıldıktan sonra aktarılan hücreleri tablo şeklinde yapabilirm.YALNIZ birde aktarılan yer 5 satırdan itibaren başlayacak.saygılar

 

[Huseyinkis]

Sayın hüseyin aktarma işlemi olmuş acaba akaraılan sayfada aktarıldıktan sonra aktarılan hücreleri tablo şeklinde yapabilirm.YALNIZ birde aktarılan yer 5 satırdan itibaren başlayacak.saygılar

kodları ekteki gibi değiştirirmisiniz.

Sub Aktar()
Sheets("A").Select
Range("B5:B22").Select
Selection.Copy
Sheets("B").Select
sonsat = Sheets("B").Range("A65536").End(3).Row + 1

if sonsat<5 then 
Cells(5, "A").Select
else 
Cells(Sonsat, "A").Select
end if
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Sheets("A").Select
    
End Sub

 

[ormann]

SAYIN HOCAM ŞÖYLE BİR HATA VERİYO (.TintAndShade = 0)

 

[Huseyinkis]

SAYIN HOCAM ŞÖYLE BİR HATA VERİYO (.TintAndShade = 0)

2007 den kaynaklanıyor olabilir siz satırlarda

.ColorIndex = 0
.TintAndShade = 0

kısımlarını kaldırın. ben 2007 macro çalıştır uzerinden yapmıştım sanırım 2003 de bu fonksiyon yok. :kafa:

 

[ormann]

Sayın hocam çok teşekkür ederim.ellerinize sağlık

 

[Muhammet Okumuş]

Application.ScreenUpdating = False
kodların başına koyarsanız, sayfalar arası gel git yapmaz