¿Cómo buscar la ultima columna que tenga valor en una macro?
Tengo el siguiente código de macro y quiero que en vez de prefijar la columna "AS" que coja la ultima columna que contenga valor en el fichero y después se le adicionan 2 columnas nuevas que también las prefije en "AT" y "AU" y quiero que no sean fijas, si no poner las 2 columnas siguientes a la columna que tenia el ultimo valor que en dependencia de las columnas que tenga el fichero CSV que pueden ser diferentes, no siempre AS ni AT ni AU.
¿Alguna idea?
Gracias,
Aleida
Sub Consolidar_csv()
Dim Ruta As String, nom As String
Dim arch As Variant
Dim l2 As Workbook
Dim sh1 As Worksheet, sh2 As Worksheet
Dim u1 As Long, u2 As Long
'
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'
Set sh1 = Sheets("Sheet1")
sh1.Cells.Clear
'
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Seleccione archivos csv"
.Filters.Clear
.Filters.Add "Archivos csv", "*.csv"
.FilterIndex = 1
.AllowMultiSelect = True
.InitialFileName = ThisWorkbook.Path & "\"
If .Show Then
code = 1
For Each arch In .SelectedItems
Set l2 = Workbooks.Open(arch)
Set sh2 = l2.ActiveSheet
nom = Mid(arch, 1, Len(arch) - 4)
'nom = Split(nom, "_")(0)
arch = Split(nom, Application.PathSeparator)
nom = arch(UBound(arch))
u1 = sh1.Range("A" & Rows.Count).End(3).Row + 1
u2 = sh2.Range("A" & Rows.Count).End(3).Row
'
Selection.NumberFormat = "@"
sh1.Range("A:A").NumberFormat = "00000"
sh1.Range("A1:AS1").Value = sh2.Range("A1:AS1").Value
sh1.Range("A" & u1).Resize(u2 - 1, Columns("AS").Column).Value = _
sh2.Range("A2:AS" & u2).Value
sh1.Range("AT1").Value = "Version"
sh1.Range("AU1").Value = "Code"
sh1.Range("AT" & u1).Resize(u2 - 1).Value = nom
sh1.Range("AU" & u1).Resize(u2 - 1).Value = code
'
l2.Close False
code = code + 1
Next
End If
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Fin"
End Sub
1 Respuesta
Respuesta de Dante Amor
3
Prueba la siguiente:
Sub Consolidar_csv()
'Por Dante Amor
Dim Ruta As String, nom As String
Dim arch As Variant
Dim l2 As Workbook
Dim sh1 As Worksheet, sh2 As Worksheet
Dim u1 As Long, u2 As Long, code As Long, lc As Long
'
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'
Set sh1 = Sheets("Sheet1")
sh1.Cells.Clear
'
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Seleccione archivos csv"
.Filters.Clear
.Filters.Add "Archivos csv", "*.csv"
.FilterIndex = 1
.AllowMultiSelect = True
.InitialFileName = ThisWorkbook.Path & "\"
If .Show Then
code = 1
For Each arch In .SelectedItems
Set l2 = Workbooks.Open(arch)
Set sh2 = l2.ActiveSheet
nom = Mid(arch, 1, Len(arch) - 4)
'nom = Split(nom, "_")(0)
arch = Split(nom, Application.PathSeparator)
nom = arch(UBound(arch))
u1 = sh1.Range("A" & Rows.Count).End(3).Row + 1
u2 = sh2.Range("A" & Rows.Count).End(3).Row
lc = sh2.Cells.Find("*", , xlValues, , xlByColumns, xlPrevious).Column
'
Selection.NumberFormat = "@"
sh1.Range("A:A").NumberFormat = "00000"
sh1.Range("A1", sh1.Cells(1, lc)).Value = sh2.Range("A1", sh2.Cells(1, lc)).Value
sh1.Range("A" & u1).Resize(u2 - 1, lc).Value = sh2.Range("A2", sh2.Cells(u2, lc)).Value
sh1.Cells(1, lc + 1).Value = "Version"
sh1.Cells(1, lc + 2).Value = "Code"
sh1.Cells(u1, lc + 1).Resize(u2 - 1).Value = nom
sh1.Cells(u1, lc + 2).Resize(u2 - 1).Value = code
'
l2.Close False
code = code + 1
Next
End If
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Fin"
End Sub
