Belli Sütunları Başka Sayfaya Kopyalamak

[cimcoz]

Merhaba,

Ekteki dosyama göre;

Semtler sayfasından, Data sayfasına mevcut yapımda aşağıdaki makro ile A-AG arasındaki sütunları kopyalayabiliyorum.

Sub DataKaydet()
Dim say As Integer
Set s1 = Worksheets("Semtler")
Set S2 = Worksheets("Data")
say = WorksheetFunction.CountA(S2.Range("A:A"))
s1.Range("a2:ag1000").Copy
S2.Cells(say + 1, 1).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
Range("y10").Select
Range("A1").Select
End Sub

Ancak;

Semtler sayfasından, sadece A,B,C,E,O,Y ve AG sütunları Data sayfasına kopyalamak istersem, mevcut makro kodumda nerelerin değişmesi gerekir?

Gerekli düzeltmenin sağlanması için yardımcı olmanızı rica eder, iyi haftalar dilerim.

Saygılarımla,

 

[Ömer]

Merhaba

Kopyalama işlemini her sütun için yapmanız gerekir.

Sub DataKaydet()
Dim say As Integer
Set s1 = Worksheets("Semtler")
Set S2 = Worksheets("Data")
say = WorksheetFunction.CountA(S2.Range("A:A"))
s1.Range("a2:c1000").Copy
S2.Cells(say + 1, 1).PasteSpecial Paste:=xlValues
s1.Range("e2:e1000").Copy
S2.Cells(say + 1, 4).PasteSpecial Paste:=xlValues
s1.Range("o2:o1000").Copy
S2.Cells(say + 1, 5).PasteSpecial Paste:=xlValues
s1.Range("y2:y1000").Copy
S2.Cells(say + 1, 6).PasteSpecial Paste:=xlValues
s1.Range("ag2:ag1000").Copy
S2.Cells(say + 1, 7).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
Range("y10").Select
Range("A1").Select
End Sub

.

 

[cimcoz]

Merhaba

Kopyalama işlemini her sütun için yapmanız gerekir.

Sub DataKaydet()
Dim say As Integer
Set s1 = Worksheets("Semtler")
Set S2 = Worksheets("Data")
say = WorksheetFunction.CountA(S2.Range("A:A"))
s1.Range("a2:c1000").Copy
S2.Cells(say + 1, 1).PasteSpecial Paste:=xlValues
s1.Range("e2:e1000").Copy
S2.Cells(say + 1, 4).PasteSpecial Paste:=xlValues
s1.Range("o2:o1000").Copy
S2.Cells(say + 1, 5).PasteSpecial Paste:=xlValues
s1.Range("y2:y1000").Copy
S2.Cells(say + 1, 6).PasteSpecial Paste:=xlValues
s1.Range("ag2:ag1000").Copy
S2.Cells(say + 1, 7).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
Range("y10").Select
Range("A1").Select
End Sub

.

Sayın Ömer,

Teşekkür ederim..

Şu şekilde aynı sonucu alabilirim değil i?

Sub DataSave2()
Dim say As Integer
Set s1 = Worksheets("BetsResults")
Set S2 = Worksheets("LeagueResultsAll")
say = WorksheetFunction.CountA(S2.Range("A:A"))
s1.Range("B3:B1000,c3:c1000,e3:e1000,o31000,y3:y1000,ag3:ag1000").Copy
S2.Cells(say + 1, 1).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
Range("y10").Select
Range("A1").Select
MsgBox "Data Copied Successfully..!!"
End Sub

 

[Ömer]

Evet bu şekilde de kullanabilir siniz.