Mehmet Sait
Altın Üye
- Katılım
- 19 Ekim 2009
- Mesajlar
- 840
- Excel Vers. ve Dili
- Office 2016 TR
- Altın Üyelik Bitiş Tarihi
- 08-09-2028
Merhaba,
Ekli kod ile aktarım yaparken verileri aldığı sayfada bulunan hücre biçimlerini almamasını sadece sayı olarak yapıştırmasını ve CK129:CW134 aralığında ki verileri okurken her satırın CP hücresini kontrol edip sıfırdan büyükse o satırı komple yazmasını satırlar arasında boşluk olmadan getirmesi ne gibi bir değişiklik yapmam gerekir?
Yardımlarınız için teşekkür ederim.
Ekli kod ile aktarım yaparken verileri aldığı sayfada bulunan hücre biçimlerini almamasını sadece sayı olarak yapıştırmasını ve CK129:CW134 aralığında ki verileri okurken her satırın CP hücresini kontrol edip sıfırdan büyükse o satırı komple yazmasını satırlar arasında boşluk olmadan getirmesi ne gibi bir değişiklik yapmam gerekir?
Yardımlarınız için teşekkür ederim.
Kod:
Sub BirlestirÜçüncüTablo()
Dim wsGunduz As Worksheet, wsAksam As Worksheet, wsGece As Worksheet, wsTumVeriler As Worksheet
Dim lastRow As Long, targetRow As Long
[V4:AH200].ClearContents
' Çalışma sayfalarını belirle
Set wsGunduz = Sheets("Gündüz")
Set wsAksam = Sheets("Akşam")
Set wsGece = Sheets("Gece")
Set wsTumVeriler = Sheets("Tüm Veriler")
' Gündüz verilerini kopyala
lastRow = wsGunduz.Cells(wsGunduz.Rows.Count, "CK").End(xlUp).Row
If lastRow > 129 Then
targetRow = wsTumVeriler.Cells(wsTumVeriler.Rows.Count, "V").End(xlUp).Row + 1
wsGunduz.Range("CK129:CW134" & lastRow).Copy wsTumVeriler.Range("V" & targetRow)
End If
' Akşam verilerini kopyala
lastRow = wsAksam.Cells(wsAksam.Rows.Count, "CK").End(xlUp).Row
If lastRow > 129 Then
targetRow = wsTumVeriler.Cells(wsTumVeriler.Rows.Count, "V").End(xlUp).Row + 1
wsAksam.Range("CK129:CW134" & lastRow).Copy wsTumVeriler.Range("V" & targetRow)
End If
' Gece verilerini kopyala
lastRow = wsGece.Cells(wsGece.Rows.Count, "CK").End(xlUp).Row
If lastRow > 129 Then
targetRow = wsTumVeriler.Cells(wsTumVeriler.Rows.Count, "V").End(xlUp).Row + 1
wsGece.Range("CK129:CW134" & lastRow).Copy wsTumVeriler.Range("V" & targetRow)
End If
Application.ScreenUpdating = False
ActiveSheet.Range("B4").Select
End Sub
Ekli dosyalar
-
10.3 KB Görüntüleme: 2
Son düzenleme: