¿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
Respuesta
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

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas