değer olarak kopyala ve boş satır sil

S

sevensuleyman

Altın Üye
Katılım
9 Kasım 2012
Mesajlar
198
Excel Vers. ve Dili
office 2010
Altın Üyelik Bitiş Tarihi
08-12-2027
merhaba ; aşağıda bulunan vba koldarı ile excell sayafamı kopyalıyor ve yeni excell olarak kaydediyorum.
sayfa kopyalama işlleminde kopyalanan verilerin sadece değer olarak kopyalanmasını istiyorum.

bu excell sayfasında A sütununda formül mevcut. formüllerim mevcut formülleri boş olarka göstermekteyim. B sütunu boş ise tüm satırı silmesini istiyorum. kopyalama yaparken boş satırları silmesi için kodu nasıl düzenlemem gerekir. yardımcı olursanız sevinirim.







Private Sub CommandButton1_Click()


Dim S1 As Worksheet, i As Long, sat As Long, j As Byte

Set S1 = Sheets("OZM_kaynak_FİYAT")

Application.ScreenUpdating = False
Sheets("ürünler").Select
Range("B2:Z" & Rows.Count).ClearContents
Range("ab2:ah" & Rows.Count).ClearContents





sat = 2
For i = 2 To S1.Cells(Rows.Count, "B").End(xlUp).Row



Cells(sat, "B") = S1.Cells(i, "A")
Cells(sat, "C") = S1.Cells(i, "B")
Cells(sat, "D") = "Güvenilir Hızlı Alışveriş"
Cells(sat, "E") = S1.Cells(i, "B")
Cells(sat, "F") = "3"
Cells(sat, "G") = "1003038"
Cells(sat, "H") = "Motosiklet > Yedek Parça & Aksesuar > Yedek Parça"
Cells(sat, "I") = S1.Cells(i, "I")
Cells(sat, "L") = "30/05/2021"
Cells(sat, "M") = "30/05/2023"
Cells(sat, "N") = "5"
Cells(sat, "P") = S1.Cells(i, "I")
Cells(sat, "T") = "'false"
Cells(sat, "W") = "0.00"
Cells(sat, "Z") = "ss"
Cells(sat, "AC") = "1"
Cells(sat, "AD") = "0"
Cells(sat, "AE") = "TL"






sat = sat + 1


Next i










Range("B1").Select
Application.CutCopyMode = False

Sheets("ürünler").Copy
Range("B:B").SpecialCells(xlCellTypeBlanks).Rows.Delete xlUp
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & "N11 güncelleme_FİYAT_" & Format(Now, "( dd.mm.yyyy.hhmm )") & ".xlsx", 51
ActiveWorkbook.Close
Application.DisplayAlerts = True

MsgBox "Aktarım Bitti.", vbInformation
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,329
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Merhaba,

Forumda kod paylaşırken aşağıdaki görselde ki menüyü kullanırsanız daha okunaklı ve düzgün görünecektir.

228585

Ek olarak sorunuzun cevaplanması için küçük bir örnek dosya üzerinde tarif ederseniz daha faydalı olacaktır.
 
S

sevensuleyman

Altın Üye
Katılım
9 Kasım 2012
Mesajlar
198
Excel Vers. ve Dili
office 2010
Altın Üyelik Bitiş Tarihi
08-12-2027
merhaba ; aşağıda bulunan buton ile excell sayafamı kopyalıyor ve yeni excell excelinin bulunduğu aktif klasöre kopyalıyor olarak kaydediyorum.
bu excell sayfasında yeşil renkli sütunlar formüllü alanardır.



sayfa kopyalama işlleminde kopyalanan verilerin sadece değer olarak kopyalanmasını istiyorum.
A sütutnda formül çok satırda oldugu için aktarırken formülleride aktarıyor. boş olan tüm satırı silmesini istiyorum.

bu excell sayfasında yeşil alanlarDA formül mevcut. formüllerim mevcut formülleri boş olarka göstermekteyim. kopyalama yaparken boş satırları silmesi için kodu nasıl düzenlemem gerekir. yardımcı olursanız sevinirim.
 

Ekli dosyalar

Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,329
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Aşağıdaki kodu dosyayı kaydeden satırın üstüne ekleyip deneyiniz.

B sütunundaki son dolu hücreye göre işlem yapar.

C++: 
Son = Cells(Rows.Count, 2).End(3).Row + 1
Range("A" & Son & ":A" & Rows.Count).EntireRow.Delete xlUp
 
S

sevensuleyman

Altın Üye
Katılım
9 Kasım 2012
Mesajlar
198
Excel Vers. ve Dili
office 2010
Altın Üyelik Bitiş Tarihi
08-12-2027
Korhan Ayhan' Alıntı:
Aşağıdaki kodu dosyayı kaydeden satırın üstüne ekleyip deneyiniz.

B sütunundaki son dolu hücreye göre işlem yapar.

C++: 
Son = Cells(Rows.Count, 2).End(3).Row + 1
Range("A" & Son & ":A" & Rows.Count).EntireRow.Delete xlUp
Genişletmek için tıkla ...
Kod: 
Private Sub CommandButton1_Click()


Dim S1 As Worksheet, i As Long, sat As Long, j As Byte
    
    Set S1 = Sheets("OZM_kaynak_FİYAT")
    
    Application.ScreenUpdating = False
    Sheets("ürünler").Select
    Range("B2:Z" & Rows.Count).ClearContents
    Range("ab2:ah" & Rows.Count).ClearContents

    

    
    
    sat = 2
    For i = 2 To S1.Cells(Rows.Count, "B").End(xlUp).Row
        
 
        
        Cells(sat, "B") = S1.Cells(i, "A")
        Cells(sat, "C") = S1.Cells(i, "B")
        Cells(sat, "D") = "Güvenilir Hızlı Alışveriş"
        Cells(sat, "E") = S1.Cells(i, "B")
        Cells(sat, "F") = "3"
        Cells(sat, "G") = "1003038"
        Cells(sat, "H") = "Motosiklet > Yedek Parça & Aksesuar > Yedek Parça"
        Cells(sat, "I") = S1.Cells(i, "I")
        Cells(sat, "L") = "30/05/2021"
        Cells(sat, "M") = "30/05/2023"
        Cells(sat, "N") = "5"
         Cells(sat, "P") = S1.Cells(i, "I")
        Cells(sat, "T") = "'false"
        Cells(sat, "W") = "0.00"
        Cells(sat, "Z") = "SEVENKARDEŞLER"
        Cells(sat, "AC") = "1"
        Cells(sat, "AD") = "0"
        Cells(sat, "AE") = "TL"
    
    
        
                    

        
        sat = sat + 1
        

    Next i
    
    
 
 
 
 
 
 
 
   Son = Cells(Rows.Count, 2).End(3).Row + 1
Range("A" & Son & ":A" & Rows.Count).EntireRow.Delete xlUp
    
  Range("B1").Select
    Application.CutCopyMode = False

    Sheets("ürünler").Copy
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & "N11 güncelleme_FİYAT_" & Format(Now, "( dd.mm.yyyy.hh.mm.ss )") & ".xlsx", 51
  
    ActiveWorkbook.Close
    Application.DisplayAlerts = True
    
    MsgBox "Aktarım Bitti.", vbInformation
End Sub
yukarıdaki kod için teşekkürler.

korhan bey birde sayfayı kopyalarken formülleri aktarmadan tüm verileri metin olarak kopyalamak istiyorum. bunun için kod düzenlemesini nasıl yapmam gerekli. bu konuda dayardımcı olursanız çok sevinirim.
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,329
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Deneyiniz.

C++: 
    Application.Calculation = xlCalculationManual
    Range("A2:AI" & Rows.Count).Copy
    Range("A2").PasteSpecial xlPasteValues
    Son = Cells(Rows.Count, 2).End(3).Row + 1
    Range("A" & Son & "A" & Rows.Count).EntireRow.Delete xlUp
 
S

sevensuleyman

Altın Üye
Katılım
9 Kasım 2012
Mesajlar
198
Excel Vers. ve Dili
office 2010
Altın Üyelik Bitiş Tarihi
08-12-2027
Korhan Ayhan' Alıntı:
Deneyiniz.

C++: 
    Application.Calculation = xlCalculationManual
    Range("A2:AI" & Rows.Count).Copy
    Range("A2").PasteSpecial xlPasteValues
    Son = Cells(Rows.Count, 2).End(3).Row + 1
    Range("A" & Son & "A" & Rows.Count).EntireRow.Delete xlUp
Genişletmek için tıkla ...
Kod: 
Private Sub CommandButton1_Click()


Dim S1 As Worksheet, i As Long, sat As Long, j As Byte
    
    Set S1 = Sheets("OZM_kaynak_FİYAT")
    
    Application.ScreenUpdating = False
    Sheets("ürünler").Select
    Range("B2:Z" & Rows.Count).ClearContents
    Range("ab2:ah" & Rows.Count).ClearContents

    

    
    
    sat = 2
    For i = 2 To S1.Cells(Rows.Count, "B").End(xlUp).Row
        
 
        
        Cells(sat, "B") = S1.Cells(i, "A")
        Cells(sat, "C") = S1.Cells(i, "B")
        Cells(sat, "D") = "Güvenilir Hızlı Alışveriş"
        Cells(sat, "E") = S1.Cells(i, "B")
        Cells(sat, "F") = "3"
        Cells(sat, "G") = "1003038"
        Cells(sat, "H") = "Motosiklet > Yedek Parça & Aksesuar > Yedek Parça"
        Cells(sat, "I") = S1.Cells(i, "I")
        Cells(sat, "L") = "30/05/2021"
        Cells(sat, "M") = "30/05/2023"
        Cells(sat, "N") = "5"
         Cells(sat, "P") = S1.Cells(i, "I")
        Cells(sat, "T") = "'false"
        Cells(sat, "W") = "0.00"
        Cells(sat, "Z") = "SEVENKARDEŞLER"
        Cells(sat, "AC") = "1"
        Cells(sat, "AD") = "0"
        Cells(sat, "AE") = "TL"
    
    
        
                    

        
        sat = sat + 1
        

    Next i
    
    
 
 
 
 
 
 
 
 
  Range("B1").Select
    Application.CutCopyMode = False
    
    Sheets("ürünler").Copy
    Application.DisplayAlerts = False
    
    Application.Calculation = xlCalculationManual
    
    Range("A2:AI" & Rows.Count).Copy
    Range("A2").PasteSpecial xlPasteValues
    
    Son = Cells(Rows.Count, 2).End(3).Row + 1
    Range("A" & Son & "A" & Rows.Count).EntireRow.Delete xlUp
    
    
    ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & "N11 güncelleme_FİYAT_" & Format(Now, "( dd.mm.yyyy.hh.mm.ss )") & ".xlsx", 51
    ActiveWorkbook.Close
    Application.DisplayAlerts = True
    
    MsgBox "Aktarım Bitti.", vbInformation
End Sub



korhan bey ; yukarıdaki gibi kodu kopyaladım kaynak excell olarak kullandıgım exceldeki formülleri silmektedir. kaynak olarak kullandığım exceldeki formülleri bozmadan kopyalanan exceldeki boş satırlar silinmesi lazım.

kodu bu şekilde düzenledim .silme işleminin yapıldıgı yerde hata almaktayım.
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,329
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Bu durumda sayfayı setlemek işi çözecektir.

C++: 
Private Sub CommandButton1_Click()
    Dim S1 As Worksheet, S2 As Worksheet, i As Long, sat As Long, j As Byte
    
    Set S1 = Sheets("OZM_kaynak_FİYAT")
    
    Application.ScreenUpdating = False
    Sheets("ürünler").Select
    Range("B2:Z" & Rows.Count).ClearContents
    Range("ab2:ah" & Rows.Count).ClearContents

    sat = 2
    
    For i = 2 To S1.Cells(Rows.Count, "B").End(xlUp).Row
        Cells(sat, "B") = S1.Cells(i, "A")
        Cells(sat, "C") = S1.Cells(i, "B")
        Cells(sat, "D") = "Güvenilir Hızlı Alışveriş"
        Cells(sat, "E") = S1.Cells(i, "B")
        Cells(sat, "F") = "3"
        Cells(sat, "G") = "1003038"
        Cells(sat, "H") = "Motosiklet > Yedek Parça & Aksesuar > Yedek Parça"
        Cells(sat, "I") = S1.Cells(i, "I")
        Cells(sat, "L") = "30/05/2021"
        Cells(sat, "M") = "30/05/2023"
        Cells(sat, "N") = "5"
        Cells(sat, "P") = S1.Cells(i, "I")
        Cells(sat, "T") = "'false"
        Cells(sat, "W") = "0.00"
        Cells(sat, "Z") = "SEVENKARDEŞLER"
        Cells(sat, "AC") = "1"
        Cells(sat, "AD") = "0"
        Cells(sat, "AE") = "TL"
        sat = sat + 1
    Next i
  
    Range("B1").Select
    
    Sheets("ürünler").Copy
    Set S2 = ActiveSheet
    
    Application.Calculation = xlCalculationManual
    S2.Range("A2:AI" & S2.Rows.Count).Copy
    S2.Range("A2").PasteSpecial xlPasteValues
    Son = S2.Cells(S2.Rows.Count, 2).End(3).Row + 1
    S2.Range("A" & Son & ":A" & Rows.Count).EntireRow.Delete xlUp
    S2.Range("B1").Select
    
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & "N11 güncelleme_FİYAT_" & Format(Now, "( dd.mm.yyyy.hh.mm") & ".xlsx", 51
    ActiveWorkbook.Close
    Application.DisplayAlerts = True
    
    Application.Calculation = xlCalculationAutomatic
    
    MsgBox "Aktarım Bitti.", vbInformation
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst