Vba Kod Yardımı

Mehmet Sait

Altın Üye
Katılım
19 Ekim 2009
Mesajlar
834
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.

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

Son düzenleme:
Üst