Hola, necesito ayuda con una Macro

hola, mira a ver si te vale alguna de estas dos opciones:

características comunes para los códigos de ej.:

Hoja1 contiene los datos que quieres copiar. Están en el rango A1:F1
(escribe lo que quieras en estas celdas)
Hoja 2 : se pegara lo que haya en la celda correspondiente de hoja1 cuando
se escriba una sola letra entre la A y la F
.-para el primer caso solo tienes que ir escribiendo lo que quieras y de vez
en cuando una sola letra entre la a y la f..
.-para el 2º prepárate una lista que también contenga caracteres únicos
entre a y f y ejecuta la macro.
.-para ajustar las columnas sobre las que trabajar (máximo la z) busca en la
ayuda (f1 desde el editor de vba) los valores del código así y ajustas en
los condicionales para que se corresponda con el rango deseado. Pej. si
quisieras que se limitara a las columnas A, B y C tendrías que cambiar el
'71' por '68' y el
'103' por '100'
.- para cambiar la fila de la que extraer los datos deberías cambiar donde
pone ->> (.Value & 1) el '1' por el nº de fila donde estén los datos a
copiar

y aqui van los códigos:

op1: para que cuando escribas algo en la Hoja2 si al salir de la celda lo
escrito es una letra (solo de la A a la Z, para mas columnas habría que
cambiarlo bastante) te ponga en esa celda lo que halla en la fila 1 de la
columna correspondiente de la Hoja1. Esta hecho para todas las celdas de la
hoja, pero podrías limitarlo a un rango concreto ->>>

en el modulo de la Hoja2 (pestaña de la hoja->botón derecho->ver código)
pega esto y haz unas pruebas

Prívate Sub Worksheet_Change(ByVal Target As Range)
With Target
If .Value = "" Or Len(CStr(.Value)) <> 1 Then Exit Sub
' On Error Resume Next
If Asc(.Value) > 64 And Asc(.Value) < 71 Then
.Value = Hoja1.Range(.Value & 1)
ElseIf Asc(.Value) > 96 And Asc(.Value) < 103 Then
.Value = Hoja1.Range(.Value & 1)
End If
End With
End Sub

opc2: para aplicar con un botón o desde el comando macros del menú
herramientas, o. Cambia directamente todas las coincidencias de letra de
columna en un rango determinado. da por hecho que en la ultima columna a
buscar (F en el ej) la ultima celda con datos es 'la de la ultima fila con
datos', si no es así tendrías que cambiar la letra de ->>> .[f65536] por la
letra de la columna mas larga

en un modulo normal

Sub CabiarSiLetra()
Dim celda As Range
With Hoja2
For Each celda In .Range("a2:f" & .[f65536].End(xlUp).Row)
With celda
' On Error Resume Next
If Asc(.Value) > 64 And Asc(.Value) < 71 Then _
.Value = Hoja1.Range(.Value & 1)
' On Error GoTo 0
End With
Next
End With
End Sub

espero me hayas entendido y te sirva de algo, aunque seguro hay formas
mejores

un saludo y hasta pronto
Ivan

PD: el tratamiento de errores (que pensaba haria falta si no se trataba de
un caracter asci) no parece ser necesario, pero lo he dejado como comentario
por si acaso, y quizas no estaria de mas que lo habilitaras

Hola Ivan, muchas gracias por el código, me sirve perfectamente para
lo que quiero hacer, lo dicho..., muchas gracias. ;-))

Un saludo


On 28 ene, 18:53, "Ivan" wrote:

hola, mira a ver si te vale alguna de estas dos opciones:

características comunes para los códigos de ej.:

Hoja1 contiene los datos que quieres copiar. Están en el rango A1:F1
(escribe lo que quieras en estas celdas)
Hoja 2 : se pegara lo que haya en la celda correspondiente de hoja1 cuando
se escriba una sola letra entre la A y la F
.-para el primer caso solo tienes que ir escribiendo lo que quieras y de vez
en cuando una sola letra entre la a y la f..
.-para el 2º prepárate una lista que también contenga caracteres únicos
entre a y f y ejecuta la macro.
.-para ajustar las columnas sobre las que trabajar (máximo la z) busca en la
ayuda (f1 desde el editor de vba) los valores del código así y ajustas en
los condicionales para que se corresponda con el rango deseado. Pej. si
quisieras que se limitara a las columnas A, B y C tendrías que cambiar el
'71' por '68' y el
'103' por '100'
.- para cambiar la fila de la que extraer los datos deberías cambiar donde
pone ->> (.Value & 1) el '1' por el nº de fila donde estén los datos a
copiar

y aqui van los códigos:

op1: para que cuando escribas algo en la Hoja2 si al salir de la celda lo
escrito es una letra (solo de la A a la Z, para mas columnas habría que
cambiarlo bastante) te ponga en esa celda lo que halla en la fila 1 de la
columna correspondiente de la Hoja1. Esta hecho para todas las celdas de la
hoja, pero podrías limitarlo a un rango concreto ->>>

en el modulo de la Hoja2 (pestaña de la hoja->botón derecho->ver código)
pega esto y haz unas pruebas

Prívate Sub Worksheet_Change(ByVal Target As Range)
With Target
If .Value = "" Or Len(CStr(.Value)) <> 1 Then Exit Sub
' On Error Resume Next
If Asc(.Value) > 64 And Asc(.Value) < 71 Then
.Value = Hoja1.Range(.Value & 1)
ElseIf Asc(.Value) > 96 And Asc(.Value) < 103 Then
.Value = Hoja1.Range(.Value & 1)
End If
End With
End Sub

opc2: para aplicar con un botón o desde el comando macros del menú
herramientas, o. Cambia directamente todas las coincidencias de letra de
columna en un rango determinado. da por hecho que en la ultima columna a
buscar (F en el ej) la ultima celda con datos es 'la de la ultima fila con
datos', si no es así tendrías que cambiar la letra de ->>> .[f65536] por la
letra de la columna mas larga

en un modulo normal

Sub CabiarSiLetra()
Dim celda As Range
With Hoja2
For Each celda In .Range("a2:f" & .[f65536].End(xlUp).Row)
With celda
' On Error Resume Next
If Asc(.Value) > 64 And Asc(.Value) < 71 Then _
.Value = Hoja1.Range(.Value & 1)
' On Error GoTo 0
End With
Next
End With
End Sub

espero me hayas entendido y te sirva de algo, aunque seguro hay formas
mejores

un saludo y hasta pronto
Ivan

PD: el tratamiento de errores (que pensaba haria falta si no se trataba de
un caracter asci) no parece ser necesario, pero lo he dejado como comentario
por si acaso, y quizas no estaria de mas que lo habilitaras

Hola Ivan, se podría modificar la Macro para poder usar las columnas
más allá de la 'Z'? por ejemplo la AA, AB, AC, etc

Gracias


On 28 ene, 18:53, "Ivan" wrote:

hola, mira a ver si te vale alguna de estas dos opciones:

características comunes para los códigos de ej.:

Hoja1 contiene los datos que quieres copiar. Están en el rango A1:F1
(escribe lo que quieras en estas celdas)
Hoja 2 : se pegara lo que haya en la celda correspondiente de hoja1 cuando
se escriba una sola letra entre la A y la F
.-para el primer caso solo tienes que ir escribiendo lo que quieras y de vez
en cuando una sola letra entre la a y la f..
.-para el 2º prepárate una lista que también contenga caracteres únicos
entre a y f y ejecuta la macro.
.-para ajustar las columnas sobre las que trabajar (máximo la z) busca en la
ayuda (f1 desde el editor de vba) los valores del código así y ajustas en
los condicionales para que se corresponda con el rango deseado. Pej. si
quisieras que se limitara a las columnas A, B y C tendrías que cambiar el
'71' por '68' y el
'103' por '100'
.- para cambiar la fila de la que extraer los datos deberías cambiar donde
pone ->> (.Value & 1) el '1' por el nº de fila donde estén los datos a
copiar

y aqui van los códigos:

op1: para que cuando escribas algo en la Hoja2 si al salir de la celda lo
escrito es una letra (solo de la A a la Z, para mas columnas habría que
cambiarlo bastante) te ponga en esa celda lo que halla en la fila 1 de la
columna correspondiente de la Hoja1. Esta hecho para todas las celdas de la
hoja, pero podrías limitarlo a un rango concreto ->>>

en el modulo de la Hoja2 (pestaña de la hoja->botón derecho->ver código)
pega esto y haz unas pruebas

Prívate Sub Worksheet_Change(ByVal Target As Range)
With Target
If .Value = "" Or Len(CStr(.Value)) <> 1 Then Exit Sub
' On Error Resume Next
If Asc(.Value) > 64 And Asc(.Value) < 71 Then
.Value = Hoja1.Range(.Value & 1)
ElseIf Asc(.Value) > 96 And Asc(.Value) < 103 Then
.Value = Hoja1.Range(.Value & 1)
End If
End With
End Sub

opc2: para aplicar con un botón o desde el comando macros del menú
herramientas, o. Cambia directamente todas las coincidencias de letra de
columna en un rango determinado. da por hecho que en la ultima columna a
buscar (F en el ej) la ultima celda con datos es 'la de la ultima fila con
datos', si no es así tendrías que cambiar la letra de ->>> .[f65536] por la
letra de la columna mas larga

en un modulo normal

Sub CabiarSiLetra()
Dim celda As Range
With Hoja2
For Each celda In .Range("a2:f" & .[f65536].End(xlUp).Row)
With celda
' On Error Resume Next
If Asc(.Value) > 64 And Asc(.Value) < 71 Then _
.Value = Hoja1.Range(.Value & 1)
' On Error GoTo 0
End With
Next
End With
End Sub

espero me hayas entendido y te sirva de algo, aunque seguro hay formas
mejores

un saludo y hasta pronto
Ivan

PD: el tratamiento de errores (que pensaba haria falta si no se trataba de
un caracter asci) no parece ser necesario, pero lo he dejado como comentario
por si acaso, y quizas no estaria de mas que lo habilitaras

hola,

de momento prueba con esto, aunque es (creo) muy simplificable

Sub CambiarSiLetra()
Dim celda As Range, valor As String
With Hoja2
For Each celda In .UsedRange
With celda
On Error Resume Next
If .Value <> "" And Len(Trim(.Value)) < 3 Then
Select Case Len(Trim(.Value))
Case 1
.Value = Hoja1.Range(Trim(.Value) & 1)
Case 2
If Asc(Left(UCase(Trim(.Value)), 1)) > 64 _
And Asc(Left(UCase(Trim(.Value)), 1)) < 74 Then _
.Value = Hoja1.Range(Trim(.Value) & 1)
End Select
End If
On Error GoTo 0
End With
Next
End With
End Sub

si quieres comentas como va

un saludo
ivan

hola de nuevo

prueba a ver con estos codigos

Para la hoja:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim valor
With Target
valor = .Value
On Error Resume Next
.Value = Hoja1.Range(Trim(.Value) & 1)
If Err.Number <> 0 Then .Value = valor
On Error GoTo 0
End With
End Sub

para una macro en modulo normal:

Sub CambiarSiLetra3()
Dim celda As Range, valor
With Hoja2
For Each celda In .UsedRange
With celda
valor = .Value
On Error Resume Next
.Value = Hoja1.Range(Trim(.Value) & 1)
If Err.Number <> 0 Then .Value = valor
On Error GoTo 0
End With
Next
End With
End Sub

a ver que tal

un saludo
Ivan