Kodlarda Revize

[Szg15]

With Sheets("KADRO DIŞI")
.Select
strSQL = "Select IIF(IsNull(F1),0,F1), IIF(IsNull(F2),0,F2), IIF(IsNull(F3),0,F3), IIF(IsNull(F4),0,F4) " & _
"FROM [KADRO DIŞI$B3:E4] IN '' [Excel 12.0;HDR=No;Database=" & ThisWorkbook.Path & "\" & _
dosyalar(i) & ".xlsx]"
rs.Open strSQL, adoCn, 1, 1

lst = Application.Transpose(rs.getrows)
satirlar = Array(4, 11)
For ii = 1 To 2
For iii = 1 To 4
.Cells(satirlar(ii - 1) + i, iii + 1).Value = lst(ii, iii)
Next iii
Next ii
rs.Close

If .Cells(3, "I") = dosyalar(i) Then .Cells(ii, "I").Resize(, 7).ClearContents
son = .Cells(Rows.Count, "I").End(3).Row
For ii = son To 4 Step -1
If .Cells(ii, "I") = dosyalar(i) Then .Cells(ii, "I").Resize(, 7).Delete shift:=xlUp
Next ii

strSQL = "Select * " & _
"FROM [KADRO DIŞI$I3:O100] IN '' [Excel 12.0;HDR=No;Database=" & ThisWorkbook.Path & "\" & _
dosyalar(i) & ".xlsx] WHERE ISNULL(F1)=FALSE"
rs.Open strSQL, adoCn, 1, 1
.Cells(son + 1, "I").CopyFromRecordset rs

son = .Cells(Rows.Count, "I").End(3).Row

If son > 3 Then
.Range("H3:O3").Copy
.Range("H3:O" & son).PasteSpecial xlFormats
Application.CutCopyMode = False

.Sort.SortFields.Clear
.Sort.SetRange .Range("I3:O" & son)
.Sort.SortFields.Add .Range("I3"), CustomOrder:="A ŞEFLİĞİ,1.KISIM,2.KISIM,3.KISIM"
.Sort.Apply
End If
son = .Cells(Rows.Count, "I").End(3).Row
If son = 2 Then son = 3
.Range(.Cells(son + 1, "H"), .Cells(Rows.Count, "O")).Delete shift:=xlUp
If son > 3 Then .Range("H3").AutoFill Destination:=.Range("H3:H" & son), Type:=xlFillSeries
.Range("H3").Select
Sheets("ANA SAYFA").Select
End With

adoCn.Close
Set rs = Nothing
Set adoCn = Nothing
MsgBox "YOKLAMA ÇEKİLDİ."
End Sub

KADRO DIŞI sayfalarından çekilen B3:E4 aralığını B3:G4 yapmak için,
KADRO DIŞI sayfalarından çekilen H3:O aralığını J3:Q yapmak için yukarıdaki kodlarda nasıl bir değişiklik yapmak gerekiyor? Yardımcı olursanız çok sevinirim..

 

[Szg15]

Kıymetli üstadlar yardım edebilecek kimse yok mudur?

 

[Szg15]

Uzun denemeler sonucunda SelectIFF komutuna kalın renkli kodu ekleyerek ve döngüyü 4'den 5'e (kalın renkli) çıkararak, çekilen B3:E4 aralığını B3:F4 olarak genişletebildim. Belki ihtiyaç duyan olur diye paylaşayım dedim.

With Sheets("KADRO DIŞI")
.Select
strSQL = "Select IIF(IsNull(F1),0,F1), IIF(IsNull(F2),0,F2), IIF(IsNull(F3),0,F3), IIF(IsNull(F4),0,F4), IIF(IsNull(F5),0,F5)" &
"FROM [KADRO DIŞI$B3:F4] IN '' [Excel 12.0;HDR=No;Database=" & ThisWorkbook.Path & "\" & _
dosyalar(i) & ".xlsx]"
rs.Open strSQL, adoCn, 1, 1

lst = Application.Transpose(rs.getrows)
satirlar = Array(4, 11)
For ii = 1 To 2
For iii = 1 To 5
.Cells(satirlar(ii - 1) + i, iii + 1).Value = lst(ii, iii)
Next iii
Next ii
rs.Close