İki excel dosyası veri aktar kod güncelleme

[Yaren Eslem]

Sub databaseyeaktar()
Set s1 = Sheets("Sevkiyat.")

Workbooks.Open Filename:="d:\database1.xlsm"
SON = [A65536].End(3).Select
If ActiveCell.Address = "$A$1" Then
ActiveCell.Offset(1, 0).Select
ActiveCell = 1
Else
ActiveCell.Offset(1, 0).Select
ActiveCell = ActiveCell.Offset(-1, 0) + 1
End If
ActiveCell.Offset(0, 1).Value = s1.[C2]
ActiveCell.Offset(0, 2).Value = s1.[C3]
ActiveCell.Offset(0, 3).Value = s1.[C4]
ActiveCell.Offset(0, 4).Value = s1.[C5]
ActiveCell.Offset(0, 5).Value = s1.[C6]
[A1].Select
Application.ScreenUpdating = True
MsgBox "KAYIT İŞLEMİ TAMAMLANMIŞTIR.", vbInformation
ActiveWorkbook.Close
[s1].Select

End Sub

Mevcut kod ile Sevkiyat. Adlı sayfadan, database1.xlsm dosyasına veri gidiyor; Burada ne gibi bir değişiklik yaparsak, Sevkiyat. Sayfasından A9 - R3000 Sütun ve satır arasını database1.xlsm dosyasına aktarabiliriz ?

 

[ÖmerBey]

Sevkiyat. Sayfasından A9 - R3000 Sütun ve satır arasını database1.xlsm dosyasına aktarabiliriz ?

Merhaba, [A1].Select ifadesinin öncesine aşağıdaki kodu yapıştırıp deneyiniz.
Her ihtimale karşı dosyanızın yedeğini almayı unutmayınız.

With s1.Range("A9:R3000")
    Workbooks("database1.xlsm").Sheets(1).Range("A1048576").End(3).Offset(1, 0).Resize(.Rows.Count, .Columns.Count).Value = .Value
End With

 

[Yaren Eslem]

ÖmerBey Hocam ilginize çok teşekkür ederim ellerinize sağlık,

Bu konuda bir sorunum daha çıktı, malumunuz bazı şeyler öngörülmüyor maalesef...

Rica etsem, mümkünü varsa; A9-R3000 Aralığı filtreli olsa, sadece filtreli bölümü aktarma yapabilir mi?

Oluru varsa uğraştırmayacaksam rica ediyorum, hakkınızı helal edin lütfen.

 

[ÖmerBey]

Yukarıdaki kodu silip, onun yerine aşağıdakini deneyiniz.

s1.Range("A9:R3000").SpecialCells(xlCellTypeVisible).Copy
Workbooks("database1.xlsm").Sheets(1).Range("A1048576").End(3).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False

 

[Yaren Eslem]

Çook teşekkürler elleriniz dert görmesin, sağ olun var olun. Allah razı olsun...

 

[ÖmerBey]

Rica ederim,
Allah hepimizden razı olsun.
İyi dilekleriniz için de ben teşekkür ederim.
İyi çalışmalar...