Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Consulta Excel - VBA - Fechas

85 views
Skip to first unread message

dabe...@gmail.com

unread,
Sep 22, 2017, 5:45:53 PM9/22/17
to
Estimados, les hago una consulta.. tengo una macro para copiar y pegar datos de una hoja a otra.

El problema que tengo es que cuando pega una fila con fechas, Excel me invierte el día por el mes.

Es decir, copio un formato de (dd,mm,yyyy) y pega uno de (mm,dd,yyyy). El primer formato es el que uso generalmente y con el cual está configurado mi Windows.

La pregunta es ¿Qué puedo tocar en la macro para que se copie en formato correcto?

No tengo mucho conocimiento acerca de macros, les copio la que uso a ver si me pueden ayudar.

Muchas gracias!



Sub transferirdatosotrahoja()



Dim PRO As String
Dim ORD As String
Dim REN As String
Dim Fecha As String
Dim ART As String
Dim CANT As String
Dim Entrega As String
Dim NPED As String

Dim ultimafila As Long
Dim ultimafilaauxiliar As Long
Dim cont As Long
Dim palabrabusqueda As String

palabrabusqueda = Sheets("INDEX").Cells(7, 3)
palabrabusqueda = "*" & palabrabusqueda & "*"

ultimafila = Sheets("Base").Range("B" & Rows.Count).End(xlUp).Row

If ultimafila < 2 Then
Exit Sub
End If

For cont = 2 To ultimafila
If Sheets("Base").Cells(cont, 1) Like palabrabusqueda Then
PRO = Sheets("Base").Cells(cont, 1)
ORD = Sheets("Base").Cells(cont, 2)
REN = Sheets("Base").Cells(cont, 3)
Fecha = Sheets("Base").Cells(cont, 10)
ART = Sheets("Base").Cells(cont, 11)
CANT = Sheets("Base").Cells(cont, 13)
Entrega = Sheets("Base").Cells(cont, 22)
NPED = Sheets("Base").Cells(cont, 46)


ultimafilaINDEX = Sheets("INDEX").Range("B" & Rows.Count).End(xlUp).Row
Sheets("INDEX").Cells(ultimafilaINDEX + 1, 2) = PRO
Sheets("INDEX").Cells(ultimafilaINDEX + 1, 3) = ORD
Sheets("INDEX").Cells(ultimafilaINDEX + 1, 4) = REN
Sheets("INDEX").Cells(ultimafilaINDEX + 1, 5) = Fecha
Sheets("INDEX").Cells(ultimafilaINDEX + 1, 6) = ART
Sheets("INDEX").Cells(ultimafilaINDEX + 1, 7) = CANT
Sheets("INDEX").Cells(ultimafilaINDEX + 1, 8) = Entrega
Sheets("INDEX").Cells(ultimafilaINDEX + 1, 9) = NPED
End If
Next cont



End Sub

David_erh

unread,
Sep 22, 2017, 7:27:46 PM9/22/17
to
Hola, lo primero es siempre trabajar las fechas como una variable tipo DATE así que tienes que cambiar

Dim Fecha As String por Dim Fecha As Date

Luego al copiar los datos de la hoja a la variable Fecha, indicarle que convierta el valor en una fecha de la siguiente manera:

Fecha = cdate(Sheets("Base").Cells(cont, 10))

Con lo que tu macro quedaría de la siguiente manera:

Sub transferirdatosotrahoja()

Dim PRO As String
Dim ORD As String
Dim REN As String
Dim Fecha As Date
Dim ART As String
Dim CANT As String
Dim Entrega As String
Dim NPED As String

Dim ultimafila As Long
Dim ultimafilaauxiliar As Long
Dim cont As Long
Dim palabrabusqueda As String

palabrabusqueda = Sheets("INDEX").Cells(7, 3)
palabrabusqueda = "*" & palabrabusqueda & "*"

ultimafila = Sheets("Base").Range("B" & Rows.Count).End(xlUp).Row

If ultimafila < 2 Then
Exit Sub
End If

For cont = 2 To ultimafila
If Sheets("Base").Cells(cont, 1) Like palabrabusqueda Then
PRO = Sheets("Base").Cells(cont, 1)
ORD = Sheets("Base").Cells(cont, 2)
REN = Sheets("Base").Cells(cont, 3)
Fecha = Cdate(Sheets("Base").Cells(cont, 10))
ART = Sheets("Base").Cells(cont, 11)
CANT = Sheets("Base").Cells(cont, 13)
Entrega = Sheets("Base").Cells(cont, 22)
NPED = Sheets("Base").Cells(cont, 46)


ultimafilaINDEX = Sheets("INDEX").Range("B" & Rows.Count).End(xlUp).Row
Sheets("INDEX").Cells(ultimafilaINDEX + 1, 2) = PRO
Sheets("INDEX").Cells(ultimafilaINDEX + 1, 3) = ORD
Sheets("INDEX").Cells(ultimafilaINDEX + 1, 4) = REN
Sheets("INDEX").Cells(ultimafilaINDEX + 1, 5) = Fecha
Sheets("INDEX").Cells(ultimafilaINDEX + 1, 6) = ART
Sheets("INDEX").Cells(ultimafilaINDEX + 1, 7) = CANT
Sheets("INDEX").Cells(ultimafilaINDEX + 1, 8) = Entrega
Sheets("INDEX").Cells(ultimafilaINDEX + 1, 9) = NPED
End If
Next cont

End Sub

Saludos.

David

dabe...@gmail.com

unread,
Sep 25, 2017, 11:45:57 AM9/25/17
to
Muchas gracias David! Solucionaste el problema a la perfección, sos un genio!

Abrazo

David_erh

unread,
Sep 26, 2017, 1:29:07 PM9/26/17
to
No hay de que,que bueno que mi ayuda te funcionó.

Estamos para ayudar cuando conocemos un poco del tema.

Saludos.

David.
0 new messages