Añadir excepción al exportar ficheros txt visual basic excel
Me ayudaste con una macro para exportar dos hojas excel a txt, se da el caso de que a veces está vacía una de ellas y me gustaría poder añadir una excepción de este tipo, la primera celda con datos de cada hoja es la B7
Añadiendo una condición dentro de cada uno:
IF IsNotEmpty Sheets("Hoja1").Cells("B7") Then "crea el txt de hoja1"
y así con la siguiente
IF IsNotEmpty Sheets("Hoja2").Cells("B7") Then "crea el txt de hoja2"el código oficial es este, no consigo separar las hojas para añadir esa excepción. Gracias!
Dim hojas As Variant, sh As Variant
hojas = Array("Hoja1", "Hoja2")
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim lr As Long
For Each sh In hojas
With Sheets(sh)
lr = .Range("B:AB").Find("*", , xlValues, , xlByRows, xlPrevious).Row
.Range("B7:AB" & lr).Copy
Workbooks.Add
Range("A1").PasteSpecial xlPasteValues
Range("E:E").NumberFormat = "mm/dd/yyyy"
Cells.EntireColumn.AutoFit
End With
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & "Prueba " & sh & ".txt", FileFormat:=xlText, Local:=True
ActiveWorkbook.Close False
Next
End Sub
1 Respuesta
Respuesta de Dante Amor
2
Hice algunos ajustes al código, prueba con el siguiente:
Sub test()
Dim hojas As Variant, sh As Variant
hojas = Array("Hoja1", "Hoja2")
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim lr As Long
For Each sh In hojas
With Sheets(sh)
If .Range("B7").Value <> "" Then
lr = .Range("B:AB").Find("*", , xlValues, , xlByRows, xlPrevious).Row
.Range("B7:AB" & lr).Copy
Workbooks.Add
Range("A1").PasteSpecial xlPasteValues
Range("E:E").NumberFormat = "mm/dd/yyyy"
Cells.EntireColumn.AutoFit
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & "Prueba " & .Name & ".txt", FileFormat:=xlText, Local:=True
ActiveWorkbook.Close False
End If
End With
Next
End Sub
