Corrección de Macro Actual con la función Separar Texto en Columnas
Tu me ayudaste a realizar esta macro, pero hasta ahorita me di cuenta que en algo esta fallando la macro y me gustaria que me la ayudaras a corregir.
La macro debe tomar lo que se encuentra registrado en la columna "H" y convertir eso en texto en columnas en la columna "AD" y en la Columna "AE" dado a que siempre lo que va a haber registrado en la columna "H" van a ser dos palabras separadas por "Espacio"
Ejemplo:
Plan A (Dos palabras separadas por un espacio)
Copago Medplus (Dos palabras separadas por un espacio)
Actualmente la macro lo que me esta haciendo es coger lo que esta en la columna "H" y copiarlo igual en la columna "AD" entonces si encuentra "Plan A" va y copia "Plan A" en la columna "AD" y lo mismo si encuentra "Copago Medplus" copia "Copago Medplus" en la columna "AD" pero no me esta dividiendo las palabras en cada columna"
¿Me ayudas por favor?
Aqui te envío la macro actual
Sub REGISTROS()
'Act.Por.Dante Amor
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set h1 = Sheets("VISITAS")
Set h2 = Sheets("CARTERA")
'
u = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
h1.Range("C5:C14").Copy: h2.Range("A" & u).PasteSpecial Paste:=xlPasteValues, Transpose:=True
h1.Range("F5:F14").Copy: h2.Range("K" & u).PasteSpecial Paste:=xlPasteValues, Transpose:=True
h1.Range("F2").Copy: h2.Range("U" & u).PasteSpecial Paste:=xlPasteValues, Transpose:=False
h2.Range("V3:Y3").Copy h2.Range("V" & u)
h2.Range("F" & u).TextToColumns Destination:=h2.Range("Z" & u), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 2), Array(1, 1), Array(4, 1)), TrailingMinusNumbers:=True
h2.Range("AC3").Copy h2.Range("AC" & u)
h2.Range("H" & u).TextToColumns Destination:=h2.Range("AD" & u), _
DataType:=xlDelimited, TextQualifier:=xlNone, ConsecutiveDelimiter:=True, _
FieldInfo:=Array(Array(1, 2), Array(2, 2)), TrailingMinusNumbers:=True
h2.Range("AF" & u) = "=TEXT(RC[-31],""yyyy"")"
h2.Range("AG" & u) = "=TEXT(RC[-32],""mmmm"")"
h2.Range("AH" & u) = "=IF(RC[-4]="""","""",IF(RC[-4]=""plan"",""Particulares"",RC[-3]))"
'
h1.Unprotect Password:="0976342842"
H1. Range("F5:F7"). ClearContents
H1. Range("F10:F12"). ClearContents
H1. Range("F14"). ClearContents
H1. Range("C6:C7"). ClearContents
H1. Range("C9:C12"). ClearContents
H1. Range("C14"). ClearContents
h1.Range("F2") = h1.Range("F2") + 1
h1.Protect Password:="0976342842"
End Sub
1 respuesta
H o l a:
Tienes razón, omití esta instrucción:
Space:=True
Te anexo la macro actualizada:
Sub REGISTROS()
'Act.Por.Dante Amor
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set h1 = Sheets("VISITAS")
Set h2 = Sheets("CARTERA")
'
u = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
h1.Range("C5:C14").Copy: h2.Range("A" & u).PasteSpecial Paste:=xlPasteValues, Transpose:=True
h1.Range("F5:F14").Copy: h2.Range("K" & u).PasteSpecial Paste:=xlPasteValues, Transpose:=True
h1.Range("F2").Copy: h2.Range("U" & u).PasteSpecial Paste:=xlPasteValues, Transpose:=False
h2.Range("V3:Y3").Copy h2.Range("V" & u)
h2.Range("F" & u).TextToColumns Destination:=h2.Range("Z" & u), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 2), Array(1, 1), Array(4, 1)), TrailingMinusNumbers:=True
h2.Range("AC3").Copy h2.Range("AC" & u)
h2.Range("H" & u).TextToColumns Destination:=h2.Range("AD" & u), _
DataType:=xlDelimited, TextQualifier:=xlNone, ConsecutiveDelimiter:=True, Space:=True, _
FieldInfo:=Array(Array(1, 2), Array(2, 2)), TrailingMinusNumbers:=True
h2.Range("AF" & u) = "=TEXT(RC[-31],""yyyy"")"
h2.Range("AG" & u) = "=TEXT(RC[-32],""mmmm"")"
h2.Range("AH" & u) = "=IF(RC[-4]="""","""",IF(RC[-4]=""plan"",""Particulares"",RC[-3]))"
'
h1.Unprotect Password:="0976342842"
H1. Range("F5:F7"). ClearContents
H1. Range("F10:F12"). ClearContents
H1. Range("F14"). ClearContents
H1. Range("C6:C7"). ClearContents
H1. Range("C9:C12"). ClearContents
H1. Range("C14"). ClearContents
h1.Range("F2") = h1.Range("F2") + 1
h1.Protect Password:="0976342842"
End Sub'
S a l u d o s . D a n t e A m o r.
