Merhaba,
Aşağıdaki kodun 1. döngüsünde problem olmuyor fakat 2. döngüsünde "=i3" ile biten yerde hata veriyor. makro yeni sheeti açıyor, kopyalanan yeri yeni sheete yapıştırıyor fakat yeni açılan sheete isim verirken hata veriyor.
Konu hakkında yardımlarınızı rica ederim.
For i2 = 2 To i1
Workbooks("Saha_satış_dataları.xlsx").Sheets("Fihrist").Select
Dim i3 As String
i3 = Cells(i2, 5).Text
Application.Workbooks.Open (f & "\" & Cells(i2, 5))
' A1 hücresi şube kodu açıklaması içeriyor mu? İlk kolonda şube kodu bilgisi yer alacağından ön kontroldür.
If Range("A1") <> "Şube Kodu" Then
MsgBox i3 & " raporundaki 'A1' hücresi 'Şube Kodu' bilgisini içermemektedir."
End
End If
If Range("B1") <> "İşlem Tarihi" Then
MsgBox i3 & " raporundaki 'B1' hücresi 'İşlem Tarihi' bilgisini içermemektedir."
End
End If
'Seçilen şubelere göre filtre uygulama işlemi
Columns("A:A").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
Workbooks("Satış_Kontrol_Data_Cek.xlsm").Sheets("Subelist").Range("A1:A6"), _
Unique:=False
Range("A1").Select
Selection.End(xlDown).Select
i4 = ActiveCell.Row
u21 = 0
u21 = u21 + 1
If u21 = 1 Then
Set Source = Range("A1:AZ" & i4 + 1).SpecialCells(xlCellTypeVisible)
Else
Set Source = Range("A2:AZ" & i4 + 1).SpecialCells(xlCellTypeVisible)
End If
Source.Copy
With Workbooks("Saha_satış_dataları.xlsx")
.Activate
.Worksheets.Add After:=Sheets(Sheets.Count)
Workbooks("Saha_satış_dataları.xlsx").ActiveSheet.Paste
Workbooks("Saha_satış_dataları.xlsx").ActiveSheet.Name = i3
Aşağıdaki kodun 1. döngüsünde problem olmuyor fakat 2. döngüsünde "=i3" ile biten yerde hata veriyor. makro yeni sheeti açıyor, kopyalanan yeri yeni sheete yapıştırıyor fakat yeni açılan sheete isim verirken hata veriyor.
Konu hakkında yardımlarınızı rica ederim.
For i2 = 2 To i1
Workbooks("Saha_satış_dataları.xlsx").Sheets("Fihrist").Select
Dim i3 As String
i3 = Cells(i2, 5).Text
Application.Workbooks.Open (f & "\" & Cells(i2, 5))
' A1 hücresi şube kodu açıklaması içeriyor mu? İlk kolonda şube kodu bilgisi yer alacağından ön kontroldür.
If Range("A1") <> "Şube Kodu" Then
MsgBox i3 & " raporundaki 'A1' hücresi 'Şube Kodu' bilgisini içermemektedir."
End
End If
If Range("B1") <> "İşlem Tarihi" Then
MsgBox i3 & " raporundaki 'B1' hücresi 'İşlem Tarihi' bilgisini içermemektedir."
End
End If
'Seçilen şubelere göre filtre uygulama işlemi
Columns("A:A").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
Workbooks("Satış_Kontrol_Data_Cek.xlsm").Sheets("Subelist").Range("A1:A6"), _
Unique:=False
Range("A1").Select
Selection.End(xlDown).Select
i4 = ActiveCell.Row
u21 = 0
u21 = u21 + 1
If u21 = 1 Then
Set Source = Range("A1:AZ" & i4 + 1).SpecialCells(xlCellTypeVisible)
Else
Set Source = Range("A2:AZ" & i4 + 1).SpecialCells(xlCellTypeVisible)
End If
Source.Copy
With Workbooks("Saha_satış_dataları.xlsx")
.Activate
.Worksheets.Add After:=Sheets(Sheets.Count)
Workbooks("Saha_satış_dataları.xlsx").ActiveSheet.Paste
Workbooks("Saha_satış_dataları.xlsx").ActiveSheet.Name = i3