Çözüldü Kod Hatası,

[gicimi]

Merhaba;

Aşağıdaki kodda hata alıyorum. Kontrol edebilir misiniz. Hata sebebi ne olabilir. <Hata aldığım alanı satır içi kodunda > belirttim.



SYF.Range("A" & STR).PasteSpecial xlPasteValues

Option Explicit
Sub veri_getir()
Dim XLS As Excel.Application, KTP As Workbook, KTP2 As Workbook
Dim SYF As Worksheet, SYF2 As Worksheet, STR As Long, STR2 As Long
Dim KTF As String
Dim YOL As String, DSY As String
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Sheet2.Select
Range("A2:U" & Rows.Count).ClearContents
Set XLS = CreateObject("Excel.Application"): XLS.Visible = False
YOL = ThisWorkbook.Path & "\Mart HDR\"
Set KTP = ActiveWorkbook
Set SYF = KTP.ActiveSheet
KTF = ActiveCell.Address
DSY = Dir(YOL & "*.xlsx?")
Do While DSY <> ""
If DSY <> KTP.Name Then
Set KTP2 = XLS.Workbooks.Open(YOL & DSY)
Set SYF2 = KTP2.Sheets("Sayfa1")
STR = SYF.Range("A" & Rows.Count).End(xlUp).Row + 1
STR2 = SYF2.Range("A" & Rows.Count).End(xlUp).Row
SYF2.Range("A2:U" & STR2).Copy
SYF.Range("A" & STR).PasteSpecial xlPasteValues
SYF2.Range("A2").Select
Application.DisplayAlerts = False
KTP2.Save: KTP2.Close
Application.DisplayAlerts = True
End If: DSY = Dir
Loop
Dim i As Long
For i = 2 To SYF.Cells(Rows.Count, 1).End(xlUp).Row
SYF.Cells(i, 3).Value = SYF.Cells(i, 3) * 1
Next i
Sayfa1.Select
Dim sonsat As Long: sonsat = Sayfa1.Cells(Rows.Count, 1).End(xlUp).Row
With Sayfa1.Range("J2:J" & sonsat)
.Formula = "=IFERROR(VLOOKUP(D2,AYLIK!$C$2:$O$300000,8,0),"""")"
.Value = .Value
End With

With Sayfa1.Range("K2:K" & sonsat)
.Formula = "=IFERROR(VLOOKUP(D2,AYLIK!$C$2:$O$300000,9,0),"""")"
.Value = .Value
End With
With Sayfa1.Range("L2:L" & sonsat)
.Formula = "=IFERROR(VLOOKUP(D2,AYLIK!$C$2:$O$300000,13,0),"""")"
.Value = .Value
End With
With Sayfa1.Range("M2:M" & sonsat)
.Formula = "=IFERROR(VLOOKUP(D2,AYLIK!$C$2:$O$300000,7,0),"""")"
.Value = .Value
End With
With Sayfa1.Range("N2:N" & sonsat)
.Formula = "=IFERROR(VLOOKUP(D2,AYLIK!$C$2:$O$300000,4,0),"""")"
.Value = .Value
End With
MukerrerSay
MukerrerSayfaTamamla
Dim aylikson As Long: aylikson = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row
If aylikson < 2 Then aylikson = 2
Sheet2.Range("A2:V" & aylikson).ClearContents
Dim Sht As Worksheet
For Each Sht In Application.Worksheets
    Sht.Sort.SortFields.Clear
Next Sht
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "1-)Günlük Dosyalardan Veriler alınmıştır." & Chr(10) & _
"2-)Bu sayfada ilgili Bölümlere Bilgiler aktarılmıştır." & Chr(10) & _
"3-)Mükerrer Liste Sayfasında birden fazla işlem gören Tesisat Numaraları Listelenmiştir." & Chr(10) & _
"4-)AYLIK isimli sayfadaki geçici kullanılan bilgiler Temizlenmiştir." & Chr(10) & _
" İ y i   ç a l ı ş m a l a r ", vbInformation, ""

End Sub

 

[Korhan Ayhan]

STR ve STR2 değişkenlerini kontrol edin. Aldığı değerler yapıştırma işlemine engel oluyor olabilir. Yani kopyalanan alan ile yapıştırılan alan satır sayısı bazında eşleşmiyor olabilir.

 

[Korhan Ayhan]

Kullandığınız kodu aşağıdaki gibi değiştirip deneyiniz.

Kopyala-değer yapıştır işlemi sanırım veri çokluğundan bir şekilde takılıyor. Aslında hata verdiğinde F5 tuşuna bastığınızda devam ediyor. Yine de siz zaten değerleri aldığınız için aşağıdaki yöntemi kullanabilirsiniz.

Option Explicit
Sub veri_getir()
Dim XLS As Excel.Application, KTP As Workbook, KTP2 As Workbook
Dim SYF As Worksheet, SYF2 As Worksheet, STR As Long, STR2 As Long
Dim KTF As String
Dim YOL As String, DSY As String
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Sheet2.Select
Range("A2:U" & Rows.Count).ClearContents
Set XLS = CreateObject("Excel.Application"): XLS.Visible = False
YOL = ThisWorkbook.Path & "\Mart HDR\"
Set KTP = ActiveWorkbook
Set SYF = KTP.ActiveSheet
KTF = ActiveCell.Address
DSY = Dir(YOL & "*.xlsx?")
Do While DSY <> ""
If DSY <> KTP.Name Then
Set KTP2 = XLS.Workbooks.Open(YOL & DSY)
Set SYF2 = KTP2.Sheets("Sayfa1")
STR = SYF.Range("A" & Rows.Count).End(xlUp).Row + 1
STR2 = SYF2.Range("A" & Rows.Count).End(xlUp).Row
SYF.Range("A" & STR & ":U" & STR + STR2 - 2).Value = SYF2.Range("A2:U" & STR2).Value
SYF2.Range("A2").Select
Application.DisplayAlerts = False
KTP2.Save: KTP2.Close
Application.DisplayAlerts = True
End If: DSY = Dir
Loop
Dim i As Long
For i = 2 To SYF.Cells(Rows.Count, 1).End(xlUp).Row
SYF.Cells(i, 3).Value = SYF.Cells(i, 3) * 1
Next i
Sayfa1.Select
Dim sonsat As Long: sonsat = Sayfa1.Cells(Rows.Count, 1).End(xlUp).Row
With Sayfa1.Range("J2:J" & sonsat)
.Formula = "=IFERROR(VLOOKUP(D2,AYLIK!$C$2:$O$300000,8,0),"""")"
.Value = .Value
End With

With Sayfa1.Range("K2:K" & sonsat)
.Formula = "=IFERROR(VLOOKUP(D2,AYLIK!$C$2:$O$300000,9,0),"""")"
.Value = .Value
End With
With Sayfa1.Range("L2:L" & sonsat)
.Formula = "=IFERROR(VLOOKUP(D2,AYLIK!$C$2:$O$300000,13,0),"""")"
.Value = .Value
End With
With Sayfa1.Range("M2:M" & sonsat)
.Formula = "=IFERROR(VLOOKUP(D2,AYLIK!$C$2:$O$300000,7,0),"""")"
.Value = .Value
End With
With Sayfa1.Range("N2:N" & sonsat)
.Formula = "=IFERROR(VLOOKUP(D2,AYLIK!$C$2:$O$300000,4,0),"""")"
.Value = .Value
End With
MukerrerSay
MukerrerSayfaTamamla
Dim aylikson As Long: aylikson = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row
If aylikson < 2 Then aylikson = 2
Sheet2.Range("A2:V" & aylikson).ClearContents
Dim Sht As Worksheet
For Each Sht In Application.Worksheets
    Sht.Sort.SortFields.Clear
Next Sht
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "1-)Günlük Dosyalardan Veriler alınmıştır." & Chr(10) & _
 "2-)Bu sayfada ilgili Bölümlere Bilgiler aktarılmıştır." & Chr(10) & _
 "3-)Mükerrer Liste Sayfasında birden fazla işlem gören Tesisat Numaraları Listelenmiştir." & Chr(10) & _
 "4-)AYLIK isimli sayfadaki geçici kullanılan bilgiler Temizlenmiştir." & Chr(10) & _
 " İ y i   ç a l ı ş m a l a r ", vbInformation, ""
End Sub

 

[gicimi]

@Korhan Ayhan Hocam Allah razı olsun çok sağolun.