Satıra git yapıştır

[muratgunay48]

Arkadaşlar, sayın hocalarım, bir konuda yardıma ihtiyacım var. Şimdi 3 tane dosya var. Bizim için esas dosya 1 numara makro yazan içinde dönüştürücü makroların bulunduğu dosya. 2 numara sadece ek.
Şimdi şöyle. Makroyu çalıştırınca önce 1 numarayı dönüştürüyor sonra 2 numarayı. Buraya kadar tek sıkıntı. Sayfayı sil demişim neden tekrar onay istiyor?
Yalnız şöyle ki. Her gün raporların satır sayısı farklı. Bugün 15 yarın 20 olabilir.
Raporları dönüştürdü.

Kendim yapmaya çalıştım. RAPOR EK'i açıp 2. Satırdan son dolu satıra kadar kopyalıyor. (Orada da panoya yapıştırmak ister misiniz diye soruyor.)

RAPOR'u açıp ilk boş satıra yapıştırıyor. Burada sıkıntı çerçeveleri koymuyor.

Bir de sizlerden ricam. RAPOR EK'i yapıştırınc SIRA NO 1'den değil de RAPOR'dan devam edemez mi?

Şimdiden teşekkür ederim.
Saygılarımla.

 

[muratgunay48]

Çerçeve olayını çözdüm sayılır. Ancak sadece dolu hücreleri çerçeve yapıyor. En sağ satır boş kalıyor. Orayı sonradan yazıyoruz. Puan gibi. Yazınca çerçeve olmuyor bu kodla

Application.ScreenUpdating = False
Dim ws As Worksheet, hucre As Range
Set ws = ActiveSheet

With ws
.Cells.Borders(xlInsideVertical).LineStyle = xlNone
.Cells.Borders(xlInsideHorizontal).LineStyle = xlNone
For Each hucre In .UsedRange
If hucre <> "" Then
With hucre
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
End With
End If
Next
End With
Application.ScreenUpdating = True

 

[volki_112]

Çerçeve olayını çözdüm sayılır. Ancak sadece dolu hücreleri çerçeve yapıyor. En sağ satır boş kalıyor. Orayı sonradan yazıyoruz. Puan gibi. Yazınca çerçeve olmuyor bu kodla

Application.ScreenUpdating = False
Dim ws As Worksheet, hucre As Range
Set ws = ActiveSheet

With ws
.Cells.Borders(xlInsideVertical).LineStyle = xlNone
.Cells.Borders(xlInsideHorizontal).LineStyle = xlNone
For Each hucre In .UsedRange
If hucre <> "" Then
With hucre
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
End With
End If
Next
End With
Application.ScreenUpdating = True

Dosyaniza bakamadim ama kodda hucre degeri boştan farkli ise cerceve yap demissiniz. Hucre degeri boş ise cerceve yapmaz

 

[muratgunay48]

Dosyaniza bakamadim ama kodda hucre degeri boştan farkli ise cerceve yap demissiniz. Hucre degeri boş ise cerceve yapmaz

Hocam sadece sağ (G) sütununu sonradan dolduruyoruz.
Numara önemliydi. Sizin sayenizde çözüldü.

Hocam sorma olayı var.

Kod şöyle başlıyor.


ChDir "C:\Users\muratgunay48\Desktop\XXX\"
Workbooks.Open Filename:= _
"C:\Users\muratgunay48\Desktop\XXX\1.xls"
Sheets("TÜMÜ").Select
ActiveWindow.SelectedSheets.Delete
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft

Sil demişim zaten, neden tekrar onay istiyor? Çok fazla dosya olduğu için onaylamak zaman alıyor.

 

[volki_112]

Hocam sadece sağ (G) sütununu sonradan dolduruyoruz.
Numara önemliydi. Sizin sayenizde çözüldü.

Hocam sorma olayı var.

Kod şöyle başlıyor.


ChDir "C:\Users\muratgunay48\Desktop\XXX\"
Workbooks.Open Filename:= _
"C:\Users\muratgunay48\Desktop\XXX\1.xls"
Sheets("TÜMÜ").Select
ActiveWindow.SelectedSheets.Delete
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft

Sil demişim zaten, neden tekrar onay istiyor? Çok fazla dosya olduğu için onaylamak zaman alıyor.

Silme satirinin üstüne bu satiri yazin

Application.DisplayAlerts = False
' Uyarıları kapat 

silme satirinin altina da bunu yazin
   Application.DisplayAlerts = True
' Uyarıları tekrar aç

 

[muratgunay48]

Silme satirinin üstüne bu satiri yazin

Application.DisplayAlerts = False
' Uyarıları kapat

silme satirinin altina da bunu yazin
   Application.DisplayAlerts = True
' Uyarıları tekrar aç

Teşekkür ederim hocam.