Problema con macro: necesito que modifiquen mi macro para que repita una acción
En negrita he escrito la orden que se repite desde la primera fila hasta la fila 2000. Haciendo copia y pega podría hacerlo pero es imposible.
¿Por favor podría slguien modificar la macro para ayudarme?.
Muchas gracias
Sheets("Hoja2").Select
Range("B2:F2").Select
Selection.Copy
Sheets("MACRO-nutrientes").Select
Range("C5").Select
ActiveSheet.Paste
Sheets("MACRO-nutrientes").Select
Range("C26:G26").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("dris").Select
Range("A2").Select
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Hoja2").Select
Range("b3:F3").Select
Selection.Copy
Sheets("MACRO-nutrientes").Select
Range("C5").Select
ActiveSheet.Paste
Sheets("MACRO-nutrientes").Select
Range("C26:G26").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("dris").Select
Range("A3").Select
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Hoja2").Select
Range("b4:F4").Select
Selection.Copy
Sheets("MACRO-nutrientes").Select
Range("C5").Select
ActiveSheet.Paste
Sheets("MACRO-nutrientes").Select
Range("C26:G26").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("dris").Select
Range("A4").Select
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
2 respuestas
La macro que te pase en el post anterior hace lo que pides y hasta más, de no ser así puedes indicármelo para hacer las modificaciones
¡Gracias!
Muchísimas gracias
La he probado, se ve que hace bien las bien las operaciones de copiar de hoja 2, pegar en Macroelementos y después copia de la fila 26 de Macroelementos. Pero al pegar en hoja dris lo hace mal, solo pega valores = 0
Sube una imagen de tus datos para ver que es lo que esta pasando, ¿y lo que quieres copiar a la hoja dris son fórmulas?
Son datos procedentes de fórmulas.
Si me pasas un correo t envío el fichero
Gracias
Esta macro procesa 10000 filas en 10 segundos, la anterior era algo lenta, esta manda toda la información a un contenedor de memoria y lo pega en un solo paso en la hoja dris
Option Explicit
Sub copiar_datos()
Dim inicio As Date, fin As Date
Dim h1 As Worksheet, h2 As Worksheet, h3 As Worksheet
Dim matriz As Variant, matriz2 As Variant
Dim f As Integer, i As Integer, j As Integer
Dim datos As Range, destino As Range
Dim tiempo As Single
inicio = Time
Set h1 = Worksheets("macro-nutrientes")
Set h2 = Worksheets("hoja2")
Set h3 = Worksheets("dris")
Set datos = h2.Range("b2").CurrentRegion
matriz = datos
With datos
f = .Rows.Count
Set destino = h3.Range("a2").Resize(f, 5)
matriz2 = destino
For i = 1 To f
h1.Range("c5") = matriz(i, 1)
For j = 1 To 5
matriz2(i, j) = h1.Range("c26").Cells(1, j)
Next j
Next i
End With
h3.Range(destino.Address) = matriz2
fin = Time
tiempo = fin - inicio
MsgBox (f & " REGISTROS COPIADOS EN " & _
Second(tiempo) & " SEGUNDOS"), vbInformation, "AVISO"
Erase matriz: Erase matriz2
Set datos = Nothing: Set h1 = Nothing: Set h2 = Nothing: Set h4 = Nothing
Set destino = Nothing
End Sub
Como la consulta anterior quedó ya valorada continúo aquí.
Sub dris()
'ajustada x Elsamatilde
'se declaran las hojas 'destino' para no tener que seleccionarlas
Set hon = Sheets("MACRO-nutrientes")
Set hod = Sheets("dris")
'se trabaja desde la hoja 2 recorriendo hasta el final de la col B
Sheets("Hoja2").Select
X = Range("B" & Rows.Count).End(xlUp).Row
'bucle recorriendo toda la tabla de Hoja2
For i = 2 To X
'copia solo el rango B:F pegando en hoja Macro
Range("B" & i & ":F" & i).Copy Destination:=hon.[C5]
'de hoja Macro se pega en hoja 'dris' como valores
hon.Range("C26:G26").Copy
hod.Range("A" & i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Next i
End Sub
Observa que declaro con variables las hojas destino para evitar tener que seleccionarlas.
Te hago notar que siempre pegas celdas de una fila en C5 y luego copias celdas de fila 26 a la hoja 'dris'. Estos rangos los dejaste fijos. Supongo que será correcto en tu modelo.
Sdos.
Elsa
* Mi recomendación del mes: el manual de Bucles