VBA-Macros ¿Como copiar datos de una hoja a otras (Con comando)?
Junto con saludar les comento que tengo la siguiente macros ( Mostrada al final de la pregunta) y quiero que esos mismos datos ingresados, se copien en 3 hojas más (Aparte de la ya señalada "GGEC-R-001 E200"). Saludos Cordiales.
Sub INGRESAR()
'hoja destino
Set hod = Sheets("GGEC-R-001 E200")
'hoja con el formulario
Sheets("Ingreso Nuevo Contrato").Select
sino = MsgBox("¿Confirmas guardar este registro?", vbQuestion + vbYesNo, "CONFIRMAR")
If sino <> vbYes Then MsgBox "Proceso cancelado.": Exit Sub
'se guarda la última fila ocupada en hoja destino
x = hod.Range("A" & Rows.Count).End(xlUp).Row + 1
Set busco = hod.Range("D:D").Find([D8], LookIn:=xlValues, lookat:=xlWhole)
'si no encuentra el registro se agrega al final
If busco Is Nothing Then
'se agrega fila al final
hod.Range("A" & x).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Else
y = busco.Row + 1
While hod.Range("D" & y) = [D8]
y = y + 1
Wend
'aquí debe ser insertada la fila
hod.Range("A" & y).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
x = y 'para utilizar la misma variable en instrucciones de pase
End If
hod.Range("A" & x) = [D5]
hod.Range("B" & x) = [D6]
hod.Range("C" & x) = [D7]
hod.Range("D" & x) = [D8]
hod.Range("E" & x) = [D9]
hod.Range("F" & x) = [D10]
hod.Range("G" & x) = [D11]
hod.Range("H" & x) = [D12]
'opcional: borrar el formulario para un nuevo pase o enviar un mensaje
'[D5:D12].ClearContents
[D5].Select
MsgBox "Datos guardados."
End Sub
1 Respuesta
exacto, tiene que ser en el mismo proceso.
Saludos,
A continuación la nueva macro.
Option Base 1
Sub INGRESAR()
'x Elsamatilde
'hojas destino
destinos = Array("GGEC-R-001 E200", "GGEC-R-001 FTE", "FTE Contratos Foco", "GGEC-R-001 FTE SGD Operaciones")
'hoja con el formulario
Sheets("Ingreso Nuevo Contrato").Select
sino = MsgBox("¿Confirmas guardar este registro?", vbQuestion + vbYesNo, "CONFIRMAR")
If sino <> vbYes Then MsgBox "Proceso cancelado.": Exit Sub
'se recorre la matriz de hojas
For i = 1 To 4
Set hod = Sheets(destinos(i))
'se guarda la última fila ocupada en hoja destino
x = hod.Range("A" & Rows.Count).End(xlUp).Row + 1
'según las hojas serán los rangos
Select Case i
Case Is = 1, 4
rgo = "D:D": col = 4
Case Is = 2
rgo = "G:G": col = 8
Case Is = 3
rgo = "E:E": col = 5
End Select
Set busco = hod.Range(rgo).Find([D8], LookIn:=xlValues, lookat:=xlWhole)
'si no encuentra el registro se agrega al final
If busco Is Nothing Then
'se agrega fila al final
hod.Range("A" & x).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Else
y = busco.Row + 1
While hod.Cells(y, col) = [D8]
y = y + 1
Wend
'aquí debe ser insertada la fila
hod.Range("A" & y).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
x = y 'para utilizar la misma variable en instrucciones de pase
End If
'pase de Datos en <> col según hoja
hod.Range("A" & x) = [D5]
Select Case i
Case Is = 1
hod.Range("B" & x) = [D6]
hod.Range("C" & x) = [D7]
hod.Range("D" & x) = [D8]
hod.Range("E" & x) = [D9]
hod.Range("F" & x) = [D10]
hod.Range("G" & x) = [D11]
hod.Range("H" & x) = [D12]
Case Is = 2
hod.Range("C" & x) = [D6]
Case Is = 3
Case Is = 4
End Select
Next i
'opcional: borrar el formulario para un nuevo pase o enviar un mensaje
'[D5:D12].ClearContents
[D5].Select
MsgBox "Datos guardados."
End Sub
Observa que al final faltan las instrucciones de pase para las nuevas hojas. Seguí el ejemplo de la primera y ajustá la letra que corresponda. No todas respetan las col de la 1ra. Incluso en una hoja no aparece el campo Rut.
Al copiar la macro no olvides incluir la primer instrucción (Option Base 1)
PD) Te recuerdo que tenés que dejar una fila vacía antes de los totales y eliminar las filas vacías que pudiera haber en las hojas entre datos.
Sdos.
Elsa
* Mi recomendación del mes: el manual de Bucles (Select, For, With ... todos los casos desarrollados con gran cantidad de ejemplos)
