Macro que no cambie el formato de su celda al generar nueva información.

Hola que tal experto, quisiera solicitar de su ayuda ya que por mas que
eh hecho pruebas no me sale la macro que quiero, No tengo conocimiento alguno de
programación ni en macros, y antes de pedir ayuda me puse a investigar y eh estado leyendo para ir armando yo solita mi macro, pero ahora me eh visto en la necesidad de pedir ayuda ya que por mas que hago intentos no logro resolver mi problema, tengo una parte pero su funcionalidad no es al 100, bueno lo que tengo ahora es una macro que me
distribuye a lo largo de todas las hojas la información acorde a la comparación que realiza en la celda que esta situada en la celda A1 de cada hoja, mi problema es que yo quiero que la información que encuentre me la distribuya en cada hoja a partir de la celda B15, eh puesto una variable cont, que cada que entra me incrementa en uno para que vaya
saltando celda y ponga la información uno debajo de la otra, el problema es que no se donde tengo que inicializar esta variable para que cada que es una hoja nueva comience en B15 en adelante y no donde se quedo en la hoja anterior, es decir por ahora si en la hoja
ACAPULCO empieza en B15 pero en la hoja AGUAS CALIENTES que es la siguiente comienza a llenar la información en la celda siguiente a donde finalizo en
ACAPULCO.Es decir si ACAPULCO fue de B15 a B18 en AGUAS CALIENTES sera de B19 y B 21, por ejemplo. Si pongo la variable cont = 15 dentro del ciclo lo único que
hace es empalmarme la información de cada hoja en la celda B15 es decir me pone el valor final de cada información que encontró, pero ese tampoco es el objetivo.
También me gustaría saber si me pueden apoyar u orientar ya que cada hoja tiene un formato igual, solo que no se como hacer para que cuando por ejemplo si hoy saco un
reporte y resulta que de ACAPULCO me encontró 5 datos y en mi hoja solo
tengo 2 renglones con formato me agregue 3 renglones con el mismo
formato, y si al dia siguiente genero otra vez información, y resulta
que en mi hoja ACAPULCO solo fue un dato el que me encontré me elimine
los 4 renglones y me deje solo 1 con el formato ya establecido, de
antemano muchas gracias por tomarse el tiempo de leer mi problema.

En la medida que me puedas apoyar te lo agradeceré bastante.

En la hoja SALINA CRUZ es la hoja que contiene el formato del que hablo.

http://www13.zippyshare.com/v/15221472/file.html
Anexo archivo de ejemplo y código de la macro:

Global cont as integer
Sub DistribuirPorEstado()
Dim Hoja As Worksheet
<br class="scayt-misspell" data-scayt_word="cont" data-scaytid="3" />Application.ScreenUpdating = False
Sheets("ACUMULADO").Select
For Each Hoja In Sheets
If Hoja.Name <> ActiveSheet.Name Then
'Borra el rango A:F desde la fila 2 hasta el final de datos
Hoja.Range("B15:F" & Hoja.Range("B" & Rows.Count).End(xlUp).Row + 1).Cells.ClearContents
End If
Next
cont = 15
For x = 2 To Range("A" & Rows.Count).End(xlUp).Row
If x Mod 100 = 0 Then Application.StatusBar = "... Procesando fila " & x
For Each Hoja In Sheets
'if hoja.name es diferente de la hoja anterior entonces
If Hoja.Name <> ActiveSheet.Name Then
If Range("F" & x) = Hoja.Range("A1") Then
Hoja.Cells(cont, "B").Value = Range("A" & cont)
cont = cont + 1
Exit For
End If
End If
Next
Next
Application.StatusBar = "Listo"
End Sub
GRACIAS!!!

1 respuesta

Respuesta
1

Te anexo la macro, me tomé la libertad de hacerle unos ajustes para que tenga un mejor desempeño.

Ya te pone los número de asesor, empezando en la fila 15.

Si no encuentra la hoja con la ciudad se pasa al siguiente registro.

Sub DistribuirPorEstado()
Dim Hoja As Worksheet
On Error Resume Next
Application.ScreenUpdating = False
Sheets("ACUMULADO").Select
For Each Hoja In Sheets
   If Hoja.Name <> ActiveSheet.Name Then
      'Borra el rango A:F desde la fila 2 hasta el final de datos
      Hoja.Range("B15:F" & Hoja.Range("B" & Rows.Count).End(xlUp).Row + 1).Cells.ClearContents
   End If
Next
cont = 15
cd = Range("F" & 2)
For x = 2 To Range("A" & Rows.Count).End(xlUp).Row
    If x Mod 100 = 0 Then Application.StatusBar = "... Procesando fila " & x
    If cd <> Range("F" & x) Then
        cont = 15
    End If
    Set Hestado = Worksheets(Range("F" & x).Value)
    Hestado.Cells(cont, "B").Value = Range("A" & x)
    cont = cont + 1
    cd = Range("F" & x)
Next
Application.StatusBar = "Listo"
End Sub

Realiza tus pruebas y si es lo que necesitas, podrías de favor finalizar la pregunta.
Saludos. Dam

Muchas gracias Dam por tomarte el tiempo de responder y realizar la macro la cual me genero tantas dudas, creo que para ser mi primera macro y mi primer contacto con el mundo de la programación no estuvo tan mal, pero llego un punto en donde no avanzaba.

Gracias de verdad, es lo que necesito; solo una ultima pregunta, si yo quisiera que esta información que extrae la pusiera con un formato ya establecido, como se podría lograr. En la hoja de SALINA CRUZ, viene un ejemplo de como tengo mi "hoja predefinida" la verdad desconozco si se pueda lograr que si encuentra 8 datos y en la hoja predefinida solo vienen 3 celdas con formato me agregue otras 5 con el mismo formato, si a la siguiente son solo 2 datos entonces me quite 6 renglones y me quede el mismo formato, no se si me de a explicar, estuve leyendo unos temas y encontré algo asi:

With Selection
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
End With

Para certe sincera no entiendo mucho del tema. Muchas gracias por tu gran trabajo y entrega. Estoy muy agradecida por la gran ayuda que me haz proporcionado.

Dam perdón por la insistencia, creo que la macro esta extrayendo información errónea, los números de asesor no corresponden al nombre de la hoja o bien en su defecto al nombre que viene en la celda A1. Supongo ah de ser algún ajuste o algo, copie tal cual el código, y en efecto me da la información a partir de la celda B15 pero me extrae datos que no pertenecen, perdón por no haberme fijate tanto, fue la emoción de ver funcionar la macro, pero ya cuando comencé a ver dato por dato fue cuando detecte este pequeño error.

Gracias por tu paciencia y tu ayuda altuistra.

Las primeras 2 hojas ACÁMBARO Y ACAPULCO muestran la información correcta a partir de AGUAS CALIENTES es donde comienza a mostrar información de otros estados, por ejemplo de aguas calientes muestra los ID de NEZAHUALCOYOTL y otra estado; la verdad desconozco porque este dando este tipo de información errónea, perdón por escribir tanto pero es para demostrar que no solo estoy a la espera de una solución, sino de una gran ayuda y que también de mi parte le pongo algún conocimiento aunque sea nulo comparado con el que tu me haz brindado.

Yo también me emocioné al ver que las primeras hojas estaban bien, el problema es que no existen todas las hojas, pero ya modifiqué la macro para que omita los números en caso de que su hoja no exista.

Prueba con la siguiente macro, incluye los formato de las líneas.

Sub DistribuirPorEstado()
'Distribuye números por hoja
'Por.Dam
Dim Hoja As Worksheet
On Error Resume Next
Application.ScreenUpdating = False
Sheets("ACUMULADO").Select
For Each Hoja In Sheets
If Hoja.Name <> ActiveSheet.Name Then
    'Borra el rango A:F desde la fila 2 hasta el final de datos
    Hoja.Range("B15:F" & Hoja.Range("B" & Rows.Count).End(xlUp).Row + 1).Cells.ClearContents
    ufila = 65536
    Hoja.Range("B15:F" & ufila).Borders(xlDiagonalDown).LineStyle = xlNone
    Hoja.Range("B15:F" & ufila).Borders(xlDiagonalUp).LineStyle = xlNone
    Hoja.Range("B15:F" & ufila).Borders(xlEdgeLeft).LineStyle = xlNone
    Hoja.Range("B15:F" & ufila).Borders(xlEdgeTop).LineStyle = xlNone
    Hoja.Range("B15:F" & ufila).Borders(xlEdgeBottom).LineStyle = xlNone
    Hoja.Range("B15:F" & ufila).Borders(xlEdgeRight).LineStyle = xlNone
    Hoja.Range("B15:F" & ufila).Borders(xlInsideVertical).LineStyle = xlNone
    Hoja.Range("B15:F" & ufila).Borders(xlInsideHorizontal).LineStyle = xlNone
End If
Next
cont = 15
cd = Range("F" & 2)
For x = 2 To Range("A" & Rows.Count).End(xlUp).Row
    If x Mod 100 = 0 Then Application.StatusBar = "... Procesando fila " & x
    If cd <> Sheets("Acumulado").Range("F" & x) Then
        If bien = 1 Then
        Range("B15:E15").Select
        If cont > 16 Then
            Range(Selection, Selection.End(xlDown)).Select
        End If
        Selection.Borders(xlDiagonalDown).LineStyle = xlNone
        Selection.Borders(xlDiagonalUp).LineStyle = xlNone
        Selection.Borders(xlInsideVertical).LineStyle = xlNone
        Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
        With Selection.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlThick
            .ColorIndex = 33
        End With
        With Selection.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlThick
            .ColorIndex = 33
        End With
        With Selection.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlThick
            .ColorIndex = 33
        End With
        End If
        cont = 15
    End If
    cdactual = Sheets("ACUMULADO").Range("F" & x).Value
    Set Hestado = Worksheets(cdactual)
    Hestado.Select
    If Err.Number = 0 Then
        Hestado.Cells(cont, "B").Value = Sheets("Acumulado").Range("A" & x)
        cont = cont + 1
        bien = 1
    Else
        Err.Number = 0
        bien = 0
    End If
    cd = Sheets("Acumulado").Range("F" & x)
Next
Application.StatusBar = "Listo"
End Sub

Por favor, podrías crear una pregunta por cada evento. Te lo agredecería mucho

Saludos. Dam

p.d.

Tip: para ver cómo es el funcionamiento de cualquier función, graba una macro y te genera el código, revisa el código y adáptalo a tu macro.

Antes que nada muchas gracias Dan por tomarte el tiempo de ayudarme a resolver este dilema de la macro. Eres una gran persona al brindar tu ayuda y hacernos llegar tus conocimientos altuistramente.
En horabuena y mil respetos para tu actitud hacia los demas.
Una gran ayuda.

Añade tu respuesta

Haz clic para o