DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
arkadaşlar bu kodları kullanarak işlem yapıyorumPrivate Sub CommandButton1_Click()
On Error GoTo cik:
tarih = DateValue(TextBox1.Text)
Call rapor_sayfasi_kontrol_et
Set rapor = Sheets("rapor")
rapor.Cells.ClearContents
For kopyalanacak_sayfa = 1 To Sheets.Count
If Sheets(kopyalanacak_sayfa).Name <> "Rapor" Then
Set sayfa = Sheets(kopyalanacak_sayfa)
For kopyalanacak_satir = 1 To sayfa.[a65536].End(xlUp).Row
aktarilacak_satir = rapor.[a65535].End(xlUp).Row + 1
If sayfa.Cells(kopyalanacak_satir, "a") = tarih Then
sayfa.Range("a" & kopyalanacak_satir & ":J" & kopyalanacak_satir).Copy
rapor.Range("b" & aktarilacak_satir & ":K" & aktarilacak_satir).PasteSpecial
rapor.Range("a" & aktarilacak_satir) = sayfa.Name
rapor.Range("a" & aktarilacak_satir).NumberFormat = "@"
End If
Next
End If
Next
'rapor.Select
ListBox1.Clear
ListBox1.ColumnCount = 10
ListBox1.RowSource = "rapor!a6:K" & rapor.[a65535].End(xlUp).Row
cik:
End Sub
Private Sub ListBox1_Initialize()
TextBox1.Text = Date
End Sub
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
On Error GoTo cikis:
If TextBox1.Text = "" Then TextBox1.Text = Format(Now(), "dd.mm.yyyy")
TextBox1.Text = DateValue(TextBox1.Text)
Exit Sub
cikis:
TextBox1.Text = ""
End Sub
Private Sub UserForm_Click()
End Sub
Sub rapor_sayfasi_kontrol_et()
On Error GoTo cikis:
x = Sheets("rapor").Cells(1, 1)
Exit Sub
cikis:
Sheets.Add.Name = "Rapor"
End Sub
