Copiar un dato de una hoja a otra a través de una macro
Tengo una hoja llamada "Visitas" y en ella ejecuto una macro llamada "Registros"
La macro es esta:
Sub REGISTROS() 'Act.Por.Dante Amor Application.Visible = False Application.ScreenUpdating = False Application.DisplayAlerts = False Application.Calculation = xlCalculationManual Application.EnableEvents = False ActiveSheet.DisplayPageBreaks = False Set h1 = Sheets("VISITAS") Set h2 = Sheets("CARTERA") Set h4 = Sheets("CLIENTES") ' u = h2.Range("A" & Rows.Count).End(xlUp).Row + 1 h1.Range("C5:C14").Copy: h2.Range("A" & u).PasteSpecial Paste:=xlPasteValues, Transpose:=True h1.Range("F5:F14").Copy: h2.Range("K" & u).PasteSpecial Paste:=xlPasteValues, Transpose:=True h1.Range("F2").Copy: h2.Range("U" & u).PasteSpecial Paste:=xlPasteValues, Transpose:=False h2.Range("V3:Y3").Copy h2.Range("V" & u) h2.Range("F" & u).TextToColumns Destination:=h2.Range("Z" & u), DataType:=xlFixedWidth, _ FieldInfo:=Array(Array(0, 2), Array(1, 1), Array(4, 1)), TrailingMinusNumbers:=True h2.Range("AC3").Copy h2.Range("AC" & u) h2.Range("H" & u).TextToColumns Destination:=h2.Range("AD" & u), _ DataType:=xlDelimited, TextQualifier:=xlNone, ConsecutiveDelimiter:=True, Space:=True, _ FieldInfo:=Array(Array(1, 2), Array(2, 2)), TrailingMinusNumbers:=True h2.Range("AF" & u) = "=TEXT(RC[-31],""yyyy"")" h2.Range("AG" & u) = "=TEXT(RC[-32],""mmmm"")" h2.Range("AH" & u) = "=IF(RC[-4]="""","""",IF(RC[-4]=""plan"",""Particulares"",RC[-3]))" 'aquí nueva instrucción ' h1.Unprotect Password:="0976342842" H1. Range("F5:F7"). ClearContents H1. Range("F10:F12"). ClearContents H1. Range("F14"). ClearContents H1. Range("C6:C7"). ClearContents H1. Range("C9:C12"). ClearContents H1. Range("C14"). ClearContents h1.Range("F2") = h1.Range("F2") + 1 h1.Protect Password:="0976342842" Application.ScreenUpdating = True Application.Visible = True ActiveWorkbook.Save Dim FileWsh As Object Set FileWsh = CreateObject("Scripting.FileSystemObject") MiVolumen = Hex$(FileWsh.Drives("C").SerialNumber) Select Case MiVolumen Case "9A42EB79" Application.ScreenUpdating = False Application.DisplayAlerts = False Sheets("CARTERA").Visible = True Sheets("CARTERA").Copy ruta = "\\DERMATOLOGA1\manager\Consultorio\" ActiveWorkbook.SaveAs ruta & "Registros.xlsx", FileFormat:=xlOpenXMLWorkbook ActiveWorkbook.Close Sheets("CARTERA").Visible = xlVeryHidden Case Else End Select Set FileWsh = Nothing Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True ActiveSheet.DisplayPageBreaks = True Application.CutCopyMode = False End Sub
La macro funciona muy bien pero quisiera agregarle una nueva instrucción donde dice "Aqui nueva instrucción".
La instrucción que quiero ahí es que busque el dato contenido en la celda "C7" de la hoja "VISITAS" en la columna "C" de la hoja "Clientes" y cuando lo encuentre que me copie el dato contenido en la columna "F" de esa misma fila, en la columna "AW" de la hoja "CARTERA". Quiero que me copie ese dato con la instrucción, copiar valores.
1 respuesta
Respuesta de Dante Amor
1