En relación al bucle que involucra meses

Buenas tardes, en días pasados recibí ayuda del experto Elsa Matilde, para destrabar un problemilla que tenía con un contador que involucra meses,
lo implementé pero no hace lo que debería hacer. El código de ese segmento quedó así:
'creamos una matriz con los nombres.... Completa hasta diciembre ... Listo
Dim MESES()
MESES = Array("enero", "febrero", "marzo", "abril", "mayo", "junio", "julio", "agosto", "septiembre", "octubre", "noviembre", "diciembre")
For nummes = 1 To 12        'ajustar a 12 ... Listo
  mes = MESES(nummes - 1)     'se resta 1 porque la matriz empieza en 0
    For renglon2 = 5 To 16
         'inicia en d5 hasta d16
         If Cells(renglon2, 4).Value = mes Then
           'aquí el código de lo que debe ejecutarse al encontrar coincidencia
         Sheets("consecutivo").Select
         Range("A1").Select
         ActiveCell.End(xlDown).Select
         ActiveCell.Offset(1, 0).Select
          'FOLIO
         Sheets("recibo").Select
         Range("c4").Select
         Selection.Copy
         Sheets("consecutivo").Select
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
             :=False, Transpose:=False
         'DOMICILIO
         ActiveCell.Offset(0, 1).Select
         Sheets("recibo").Select
         Range("B26").Select
         Selection.Copy
         Sheets("consecutivo").Select
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
             :=False, Transpose:=False
         'MES
         ActiveCell.Offset(0, 1).Select
         Sheets("recibo").Select
         Range("D5").Select
         Selection.Copy
         Sheets("consecutivo").Select
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
             :=False, Transpose:=False
         'TOTAL
         ActiveCell.Offset(0, 1).Select
         Sheets("recibo").Select
         Range("C15").Select
         Selection.Copy
         Sheets("consecutivo").Select
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
             :=False, Transpose:=False
              'CAJERO
         ActiveCell.Offset(0, 1).Select
         Sheets("recibo").Select
         Range("C19").Select
         Selection.Copy
         Sheets("consecutivo").Select
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
             :=False, Transpose:=False
             'FECHA
         ActiveCell.Offset(0, 1).Select
         ActiveCell = Now()
         Sheets("recibo").Select
        End If
    Next 'renglon2
Next 'nummes
End Sub
Y lo que debe hacer es copiar unas celdas de la hoja "recibo" a la hoja "consecutivo", si cierta celda en "recibo" (d5 a d16), tiene el valor de un mes
¿Puede decirme en donde está mal...? Por favor
José Manuel Sobrino
Le agradezco mucho

1 Respuesta

Respuesta
1
Te he revisado el código y, sobre todo, he cambiado muchas cosas. De todas formas creo que será más fácil de leer.
Por lo que veo copia una serie de celdas fijas (c4, b26, d5, etc...) a una página llamada 'consecutivo'.
No entiendo porqué buscas un nombre de mes en la columna "d" para luego copiar los datos de unas celdas fijas, pero supongo que es lo que quieres hacer.
Te dejo el código y si quieres vemos qué necesitas.
Un saludo
Sub comoSeLLameLaMacro()
    Dim shR As Worksheet
    Dim shC As Worksheet
    Dim numMes As Integer
    Dim mes As String
    Dim renglon2 As Integer
    Dim nLinC As Long
    'creamos una matriz con los nombres... completa hasta diciembre ... listo
    Dim MESES()
    MESES = Array("enero", "febrero", "marzo", "abril", "mayo", "junio", "julio", "agosto", "septiembre", "octubre", "noviembre", "diciembre")
    ' Asignamos las páginas a una variable para no ir cambiando de un lado a otro
    Set shR = Sheets("recibos")
    Set shC = Sheets("consecutivos")
    ' Buscamos cada uno de los meses
    For numMes = 1 To 12
        mes = MESES(numMes - 1)     'se resta 1 porque la matriz empieza en 0
        For renglon2 = 5 To 16
             'inicia en d5 hasta d16
             If UCase$(shR.Cells(renglon2, 4).Value) = UCase$(mes) Then ' Mejor comparamos todo en mayúsculas
                'aquí el código de lo que debe ejecutarse al encontrar coincidencia
                nLinC = shC.Columns(2).End(xlDown).Row + 1
                shC.Cells(nLinC, 1) = shR.Range("c4") ' FOLIO
                shC.Cells(nLinC, 2) = shR.Range("b26") 'DOMICILIO
                shC.Cells(nLinC, 3) = shR.Range("d5") ' MES
                shC.Cells(nLinC, 4) = shR.Range("c15") ' TOTAL
                shC.Cells(nLinC, 5) = shR.Range("c19") ' CAJERO
                shC.Cells(nLinC, 6) = Now() ' FECHA
            End If
        Next renglon2
    Next numMes
    Set shR = Nothing
    Set shC = Nothing
End Sub
Maestro..!
Es más fácil de leer y de entender, resolviste magistralmente 2 problemas: redujiste el código considerablemente e hiciste funcionar el famoso " contador con meses", todo de manera excelente, lo cual te agradezco sobremanera ...
El hecho de evaluar la celda ("D5" a "D16") con meses, se debe a que va a tener un valor cambiante siempre, dependiendo de que mes se pagó y cuantos fueron, pueden ser de 1 a doce valores, de acuerdo a lo anterior, y como el problema pide que se registre cada pago realizado, el " contador con meses " era lo indicado, para no repetir el código por cada celda ("D5" a "D16")y por cada mes, espero haber explicado algo.
Finalmente agradezco muy fuertemente el tiempo dedicado a resolver este problema...
El todopoderoso te regresará mucho más...
Atentamente.
José Manuel Sobrino
p.d. solo modifiqué una pequeña línea:
shC.Cells(nLinC, 3) = shR.Cells(renglon2, 4)       'MES
Para que registrara en sheets(consecutivo) todos los meses pagados.
Y una última pregunta: que hace esto shC.Columns(2). End(xlDown). Row + 1 
Más o menos, se que va al final de la hoja y busca la celda vacía, pero...
Gracias de nuevo...

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas