Calcular una celda antes de copiar y pegar vba

Estoy trabajando en una macro y copio una información en una hoja y la pego en otra hoja, pero en una de las columna, algunos de los valores que se pegan, tienen espacios adelante. Se que con la función Espacios en la hoja de calculo, elimino esos espacios. Pero yo quisiera que se eliminaran cuando pego la información, por favor, hay alguna manera de hacer algo parecido a la función Espacios en VBA o que me pueden recomendar usar.

Respuesta
1

En VBA puedes utilizar cualquiera de estas opciones:

  s = Trim(Range("A1").Value)
  s = WorksheetFunction.Trim(Range("A1").Value)

Pero cómo estás copiando?

¿Estás copiando todo un rango de celdas?

¿Estás pegando solamente valores?

Tal vez si pones aquí tu código podría proponerte una solución.

(Para poner código aquí, utiliza el icono para insertar código)

        For Each hoja In ActiveWorkbook.Sheets
            hoja.Select                         'copiando información
            Range("C1:F50").Select
                Selection.Copy
        Workbooks(MyResultados).Activate    'pegado de información
            u1 = h1.Range("C" & Rows.Count).End(xlUp).Row
            h1.Range("C" & u1).PasteSpecial Paste:=xlPasteValues
        Workbooks(MyInfo).Activate

Estoy copiando varias pestañas en una hoja, una debajo de otra, las pestañas tienen el mismo formato pero los datos de la columna C vienen con ese problema de los espacios adelante, entonces lo que quiero es que esa columna no quede con esos espacios adelante cuando los pego 

        h1.Activate
        u1 = h1.Range("C" & Rows.Count).End(xlUp).Row
        Range("C1" & ":C" & u1).Select
        For Each celda In Selection
            celda.Value = RTrim(celda.Value)
            celda.Value = LTrim(celda.Value)
            celda.Value = WorksheetFunction.Trim(celda.Value)
        Next

Después del Bucle que puse en el mensaje anterior, coloqué este pedazo, que cumple con lo que requiero pero hace muy lento el proceso de la macro, habrá una manera de hacerlo diferente para que sea más rápido?

Sería más fácil para mi si pones tu macro completa, de lo contrario tengo que suponer cómo tienes algunas líneas en la macro.

Preparé lo siguiente, cambia en la macro lo siguiente:

- "resultados.xlsx" por el nombre de tu libro MyResultados

- "Libro2.xlsx" por el nombre de tu libro MyInfo

- "Hoja1" por el nombre de la hoja de tu libro MyResultados


La macro:

Sub CopiarDatos()
  Dim hoja As Worksheet, h1 As Worksheet
  Dim arr As Variant, i As Long
  Dim MyResultados As String, MyInfo As String
  '
  Application.ScreenUpdating = False
  MyResultados = "resultados.xlsx"
  MyInfo = "Libro2.xlsx"
  '
  Set h1 = Workbooks(MyResultados).Sheets("Hoja1")
  For Each hoja In Workbooks(MyInfo).Sheets
    arr = hoja.Range("C1:F50")
    For i = 1 To UBound(arr, 1)
      arr(i, 1) = Trim(arr(i, 1))
    Next
    h1.Range("C" & Rows.Count).End(3)(2).Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
  Next
  Application.ScreenUpdating = True
End Sub

Lo que hace la macro es poner en un arreglo (arr) en memoria el rango de celdas C1:F50, después recorrer el arreglo (en memoria) y quita los espacios a los datos de la columna "C", en el arreglo es la columna 1 (arr(i,1)).

Después pasa el arreglo a la hoja.

Trabajar con arreglos en memoria hace que el proceso sea más rápido.

Prueba y me comentas. Si tienes problemas con el nombre de los libros o las hojas, entonces pon aquí tu macro completa para revisarla.

Muchas gracias Dante,

El código lo adapté a la macro y me funciona bien, pero me di cuenta que parte de la información que cae en la columna C también tiene espacios entre el texto, ejemplo "Horas extras  diurnas" fíjate que entre extras y diurnas hay un doble espacio. entonces no solo sería al final sino validar en el centro. Te paso el código completo como me indicas:

Sub LoadInfo()
Dim MyResultados As String  'donde guardo el nombre del libro de resultados
Dim MyInfo As String        'donde guardo el nombre del libro que voy a abrir
Dim InfoPath As String      'donde se guada la información de la ubicacion del libro de info
Dim arr As Variant
Dim i As Long
Set h1 = Sheets("Data")
Set h2 = Sheets("Temp")
Set h3 = Sheets("Base calculo")
If MsgBox("¿Desea actualizar la base de datos?", vbQuestion + vbYesNo, AddIn) = vbNo Then Exit Sub
Application.ScreenUpdating = False          'para que no se vea en pantalla la apertura del libro (tarda menos)
    ClearData       'función para limpiar la información de Data
    MyResultados = ThisWorkbook.Name
    InfoPath = Application.GetOpenFilename    'display para abrir libro de info
        Workbooks.Open Filename:=InfoPath     'abro el libro
    MyInfo = ActiveWorkbook.Name
    Muestra_Hojas
        For Each hoja In ActiveWorkbook.Sheets
            arr = hoja.Range("C1:F50")
            For i = 1 To UBound(arr, 1)
              arr(i, 1) = Trim(arr(i, 1))
            Next
        h1.Range("C" & Rows.Count).End(3)(2).Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
        Next
'Desde aqui se aplican la actualización del acumulado
u1 = h2.Range("A" & Rows.Count).End(xlUp).Row
h2.Range("A2" & ":E" & u1).Copy
u2 = h3.Range("A" & Rows.Count).End(xlUp).Row
h3.Range("A" & u2 + 1).PasteSpecial xlValues
h2.Range("F2" & ":AD" & u1).Copy
h3.Range("T" & u2 + 1).PasteSpecial xlValues
h3.Range("F2:S11").Copy
h3.Range("F" & u2 + 1).PasteSpecial xlPasteFormulas
Application.CutCopyMode = False
        Workbooks(MyResultados).Activate
        Worksheets("Acumulado").Activate   'para volver a la hoja de resultados
        Application.DisplayAlerts = False   'para que no salte cuadro de diálogo de clipboard
        Workbooks(MyInfo).Close SaveChanges = False 'cierro el libro de info
Application.ScreenUpdating = True
End Sub
Private Function ClearData()
        Worksheets("Data").Range("C1:F20000").ClearContents
End Function
Private Function Muestra_Hojas()
Dim numero As Byte
numero = Sheets.Count
    For i = 1 To numero
    Sheets(i).Visible = True
    Next
End Function

Cambia esta:

arr(i, 1) = Trim(arr(i, 1))

Por esta:

arr(i, 1) = WorksheetFunction.Trim(arr(i, 1))

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas