Eski bir makroyu uyarlama

[ziya]

Sub CsvKaydet()
    Dim File_Path As String, X As Date, Say As Byte
    Dim Min_Date As Date, Max_Date As Date
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    File_Path = ThisWorkbook.Path
    
    Range("A2:Y" & Rows.Count).Sort Range("B2"), xlAscending

    Min_Date = WorksheetFunction.Min(Range("B:B"))
    Max_Date = WorksheetFunction.Max(Range("B:B"))
    
    For X = Min_Date To Max_Date Step 10
        Range("A1:Y" & Rows.Count).AutoFilter 2, ">=" & CLng(CDate(X)), xlAnd, "<=" & CLng(CDate(X + 9))
        If Cells(Rows.Count, 2).End(2).Row > 1 Then
            Range("A1:Y" & Cells(Rows.Count, 2).End(3).Row).Copy
            Workbooks.Add (1)
            Range("A1").PasteSpecial
            Range("A1").Select
            Columns.AutoFit
            Say = Say + 1
            ActiveWorkbook.SaveAs File_Path & "\" & "GELENNA_" & Format(Date, "yyyy_mm") & "_" & Say & " .csv", FileFormat:=xlCSV, Local:=True
            ActiveWorkbook.Close 0
        End If
    Next
    
    On Error Resume Next
    ActiveSheet.ShowAllData
    On Error GoTo 0
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    Columns("A:F").Select
    Selection.AutoFilter
    Range("A2:Y2000").ClearContents
    Range("A102:Y2000").Delete Shift:=xlUp
    Range("A1").Select
    
    MsgBox "Veriler CSV formatında " & Say & " adet dosyaya aktarılmıştır.", vbInformation
End Sub

.
Kodlar uzun zaman önce KORHAN Hocamın kodları.
Bu çalışmada Tarih sütunu B sütunu,
Bu kodlları tarih sütunu U sütunu olan bir çalışmada kullanacağım.
Bu gördüğüm yer şeyi U olarak değiştirmek yeterli olur mu.

 

[muhasebeciyiz]

Sub CsvKaydet_U_Sutunu()
    Dim File_Path As String
    Dim X As Date
    Dim Say As Byte
    Dim Min_Date As Date
    Dim Max_Date As Date
    
    Const TARIH_SUTUN As Long = 21
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    File_Path = ThisWorkbook.Path
    Range("A2:Y" & Rows.Count).Sort Key1:=Range("U2"), Order1:=xlAscending, Header:=xlGuess
    
    Min_Date = WorksheetFunction.Min(Range("U:U"))
    Max_Date = WorksheetFunction.Max(Range("U:U"))
    
    For X = Min_Date To Max_Date Step 10
        
        Range("A1:Y" & Rows.Count).AutoFilter Field:=TARIH_SUTUN, _
                                             Criteria1:=">=" & CLng(CDate(X)), _
                                             Operator:=xlAnd, _
                                             Criteria2:="<=" & CLng(CDate(X + 9))
        
        
        If Cells(Rows.Count, TARIH_SUTUN).End(xlUp).Row > 1 Then
            
            Range("A1:Y" & Cells(Rows.Count, TARIH_SUTUN).End(xlUp).Row).Copy
            
            Workbooks.Add (1)
            Range("A1").PasteSpecial
            Range("A1").Select
            Columns.AutoFit
            
            Say = Say + 1
            ActiveWorkbook.SaveAs File_Path & "\" & "GELENNA_" & Format(Date, "yyyy_mm") & "_" & Say & " .csv", FileFormat:=xlCSV, Local:=True
            ActiveWorkbook.Close 0
        End If
    Next
    
    On Error Resume Next
    ActiveSheet.ShowAllData
    On Error GoTo 0
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    Range("A2:Y2000").ClearContents
    
    Range("A1").Select
    
    MsgBox "Veriler CSV formatında " & Say & " adet dosyaya aktarılmıştır.", vbInformation
End Sub

Tarih sütunu (B'den U'ya) sadece sütun referansının adını değiştirmekle kalmaz, aynı zamanda AutoFilter ve Cells(Rows.Count, SütunNo) gibi sütun numarasına göre işlem yapan fonksiyonlardaki 2 olan sütun numarasını 21'e (U'nun sütun numarası) çevirmeyi gerektirir. Bu kod umarım işinizi görer

 

[ziya]

Sub CsvKaydet_U_Sutunu()
    Dim File_Path As String
    Dim X As Date
    Dim Say As Byte
    Dim Min_Date As Date
    Dim Max_Date As Date
   
    Const TARIH_SUTUN As Long = 21
   
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
   
    File_Path = ThisWorkbook.Path
    Range("A2:Y" & Rows.Count).Sort Key1:=Range("U2"), Order1:=xlAscending, Header:=xlGuess
   
    Min_Date = WorksheetFunction.Min(Range("U:U"))
    Max_Date = WorksheetFunction.Max(Range("U:U"))
   
    For X = Min_Date To Max_Date Step 10
       
        Range("A1:Y" & Rows.Count).AutoFilter Field:=TARIH_SUTUN, _
                                             Criteria1:=">=" & CLng(CDate(X)), _
                                             Operator:=xlAnd, _
                                             Criteria2:="<=" & CLng(CDate(X + 9))
       
       
        If Cells(Rows.Count, TARIH_SUTUN).End(xlUp).Row > 1 Then
           
            Range("A1:Y" & Cells(Rows.Count, TARIH_SUTUN).End(xlUp).Row).Copy
           
            Workbooks.Add (1)
            Range("A1").PasteSpecial
            Range("A1").Select
            Columns.AutoFit
           
            Say = Say + 1
            ActiveWorkbook.SaveAs File_Path & "\" & "GELENNA_" & Format(Date, "yyyy_mm") & "_" & Say & " .csv", FileFormat:=xlCSV, Local:=True
            ActiveWorkbook.Close 0
        End If
    Next
   
    On Error Resume Next
    ActiveSheet.ShowAllData
    On Error GoTo 0
   
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
   
    Range("A2:Y2000").ClearContents
   
    Range("A1").Select
   
    MsgBox "Veriler CSV formatında " & Say & " adet dosyaya aktarılmıştır.", vbInformation
End Sub

Tarih sütunu (B'den U'ya) sadece sütun referansının adını değiştirmekle kalmaz, aynı zamanda AutoFilter ve Cells(Rows.Count, SütunNo) gibi sütun numarasına göre işlem yapan fonksiyonlardaki 2 olan sütun numarasını 21'e (U'nun sütun numarası) çevirmeyi gerektirir. Bu kod umarım işinizi görer

.
Teşekkür ederim.