For next döngüsü kurmak

[mersilen]

Merhabalar

Sayfa5 deki tablodaki verileri sayfa1 e aktaracak bir döngü lazım.
Yardımlarınız için teşekkürler.

Dnediğim kod çalışmadı

Sub yerlestir()

For x = 10 To Sheets(Sayfa5).Cells(Rows.Count, "A").End(xlUp).Row - 1

If Cells(x, 1).Value <> "" Then
sat = Cells(Rows.Count, "D").End(xlUp).Row + 1

For i = 4 To 11
Cells(sat, i) = Sheets(Sayfa5).Cells(x, i-3).Value
Next i
End If

Next x
End Sub

 

[Ömer]

Merhaba,

Kod, K sütununda "yazılmayacak" olanların dışındakileri mi diğer sayfaya aktaracak.

Dosyaya açıklama eklememişsiniz, yapılmak isteneni detaylı açıklarmısınız.

 

[mersilen]

Ömer hocam merhaba

Dediğiniz gibi olacak,
sayfa5 deki renkli tabloyu a10:j28 arasını aktaracak, a10:a28 arasında boş varsa o satırı almayacak, (numara olan 15 satırı alacak)

kodu yazdım ama hata veriyor

 

[Ömer]

Cevap alamadım maalesef.

A sütunudaki boş olmayanı mı alacak, yoksa K sütununda "yazılmayacak" olanların dışındakileri mi alacak?

.

 

[mersilen]

Ömer hocam ilgi için teşekkürler
sayfa5 üzerinde çalışan makroyu buldum sorunsuz çalışıyor,
ben sayfa 1 üzerinde makro yazarken hata alıyordum, buda aşağıdaki kırmızı kısımdan kaynaklanıyormuş

For x = 10 To Sheets(Sayfa5).Cells(Rows.Count, "A").End(xlUp).Row - 1

sayfa5 de çalışan makroyu ekledim bunu sayfa1 e adapte edebilirmiyiz, yada genele uygulamak mümkün müdür?Sayfa isimlerini biz manuel girebiliriz.

Sub yerlestir()
Set ws = Worksheets("Sayfa1")
'ws.Range("d11:m30") = Clear

For x = 10 To Cells(Rows.Count, "A").End(xlUp).Row - 1

If Cells(x, 1).Value <> "" Then

sat = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row + 1
For i = 4 To 11
ws.Cells(sat, i) = Cells(x, i - 3).Value
Next i
End If

Next x
End Sub

Aslında asıl yapmak istediğim aşağıdaki kodu çalıştırabilmek, döngü artarken excele kayıt yapması
linkteki kırmızı yerlerde sorun var, birde her seferinde otomatik artırıp sayfayı açacak, ie / firefox ile olabilir

For galaksi = 1 To 49
For güneşsistemi = 1 To 49



With ActiveSheet.QueryTables.Add(Connection:="URL;http://cr-all-00.www2.cashraider.de/index.php?planetenid=11250&page=galaxy&sys=&galaxyx=11&galaxyy=43", Destination:=Sheets("Sayfa5").Cells(1, 1))

Sub galaksilerikaydet()
'
For galaksi = 1 To 1
For güneşsistemi = 1 To 1



    With ActiveSheet.QueryTables.Add(Connection:="URL;http://cr-all-00.www2.cashraider.de/index.php?planetenid=11250&page=galaxy&sys=&galaxyx=11&galaxyy=43", Destination:=Sheets("Sayfa5").Cells(1, 1))
        .Name = "index.php?planetenid=11250&page=galaxy&sys=&galaxyx=11&galaxyy=41"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "5,6,7"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    Set ws = Worksheets("Sayfa1")
ws.Range("d11:m30") = Clear
xi = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row + 1
For x = xi To Cells(Rows.Count, "A").End(xlUp).Row - 1

If Cells(x, 1).Value <> "" Then
sat = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row + 1
For i = 4 To 11
ws.Cells(sat, i) = Cells(x, i - 3).Value
Next i
End If

Next x

 
Next güneşsistemi
Next galaksi
End Sub