Como copiar una varias filas a una hoja de presentación

Tengo una macro que me copia valores desde una base de datos a una hoja de presentación, pero esta macro solo copia una fila y crea una nueva hoja de presentación según cuantas filas tenga de datos, y lo que yo quiero es que me copie cada 8 filas en la hoja de presentación sucesivamente: allí envío la macro y quiero saber que código debo cambiar ´para que me copie cada 8 filas

Sub ReplicarHojaActual()
fila_dat = Worksheets("D").Range("b14").Value
item_n = Worksheets("DATO").Cells(fila_dat, 2)
Sheets("D").Copy After:=Sheets(ActiveWorkbook.Sheets.Count)
ActiveSheet.Name = "D" & item_n
End Sub
Sub llenado_datos()

fila_dat = Worksheets("D").Range("b14").Value
Cells(19, 4) = Worksheets("DATO").Cells(fila_dat, 2)
Cells(19, 5) = Worksheets("DATO").Cells(fila_dat, 3)
Cells(19, 6) = Worksheets("DATO").Cells(fila_dat, 4)
Cells(19, 7) = Worksheets("DATO").Cells(fila_dat, 5)
Cells(19, 8) = Worksheets("DATO").Cells(fila_dat, 6)
Cells(19, 12) = Worksheets("DATO").Cells(fila_dat, 7)
Cells(19, 13) = Worksheets("DATO").Cells(fila_dat, 8)
Cells(19, 17) = Worksheets("DATO").Cells(fila_dat, 9)
Cells(19, 18) = Worksheets("DATO").Cells(fila_dat, 10)
Cells(20, 3) = Worksheets("DATO").Cells(fila_dat, 15)
Cells(22, 3) = Worksheets("DATO").Cells(fila_dat, 16)
End Sub

Sub ejecutar()
For i = Range("b17") To Range("b18") Step 8
Sheets("D").Select
Worksheets("D").Range("b14").Value = i
End Sub
Sub insert_foto21()
fila_dat = Worksheets("D").Range("b14").Value

ruta_tramo = "E:\Pte Sahuinto - Kishuara\fotos\" & Worksheets("DATO").Cells(fila_dat, 11)
Set foto1 = ActiveSheet.Shapes.AddPicture(ruta_tramo, True, True, 0, 0, Range("e20:f23").Width, Range("e20:f23").Height)

With foto1
'.ShapeRange.LockAspectRatio = 0
'.ShapeRange.Name = "mapa_tramos"
'.ShapeRange.Name = "fotografias"
.Top = [e20].MergeArea.Top
.Left = [e23].MergeArea.Left
'.Width = Range("e20:f23").Width
'.Height = Range("e20:f23").Height
'.ShapeRange.ZOrder 1
End With

ruta_tramo = "E:\Pte Sahuinto - Kishuara\fotos\" & Worksheets("DATO").Cells(fila_dat, 12)
Set foto1 = ActiveSheet.Shapes.AddPicture(ruta_tramo, True, True, 0, 0, Range("i20:j23").Width, Range("i20:j23").Height)

With foto1
'.ShapeRange.LockAspectRatio = 0
'.ShapeRange.Name = "mapa_tramos"
'.ShapeRange.Name = "fotografias"
.Top = [i20].MergeArea.Top
.Left = [i23].MergeArea.Left
'.Width = Range("i20:j23").Width
'.Height = Range("i20:j23").Height
'.ShapeRange.ZOrder 1
End With
ruta_tramo = "E:\Pte Sahuinto - Kishuara\fotos\" & Worksheets("DATO").Cells(fila_dat, 13)
Set foto1 = ActiveSheet.Shapes.AddPicture(ruta_tramo, True, True, 0, 0, Range("n20:o23").Width, Range("n20:o23").Height)

With foto1
'.ShapeRange.LockAspectRatio = 0
'.ShapeRange.Name = "mapa_tramos"
'.ShapeRange.Name = "fotografias"
.Top = [n20].MergeArea.Top
.Left = [n23].MergeArea.Left
'.Width = Range("n20:o23").Width
'.Height = Range("n20:o23").Height
'.ShapeRange.ZOrder 1
End With
ruta_tramo = "E:\Pte Sahuinto - Kishuara\fotos\" & Worksheets("DATO").Cells(fila_dat, 14)
Set foto1 = ActiveSheet.Shapes.AddPicture(ruta_tramo, True, True, 0, 0, Range("q20:r23").Width, Range("q20:r23").Height)

With foto1
'.ShapeRange.LockAspectRatio = 0
'.ShapeRange.Name = "mapa_tramos"
'.ShapeRange.Name = "fotografias"
.Top = [q20].MergeArea.Top
.Left = [q23].MergeArea.Left
'.Width = Range("q20:r23").Width
'.Height = Range("q20:r23").Height
'.ShapeRange.ZOrder 1
End With

End Sub

Añade tu respuesta

Haz clic para o