Ayuda con macro
Una vez mas pidiendo de su valiosa ayuda.
De antemano gracias por leer m problema.
Tengo 3 macros idénticas solo que apuntan a diferentes rangos de columnas, una de ellas es esta:
Sub net_users()
Dim archNum As Integer
Dim Datos As Variant
Dim i As Long
Datos = Range("A1", Range("D" & Rows.Count).End(xlUp)).Value2
archNum = VBA.FreeFile
Open ThisWorkbook.Path & Application.PathSeparator & "temp.txt" For Output As #archNum
For i = LBound(Datos) To UBound(Datos)
Print #archNum, Datos(i, 1) & " " & Datos(i, 2) & " " & Datos(i, 3) & " " & Datos(i, 4)
Next i
Close #archNum
End Sub
Como le puedo hacer para los los 3 rangos me los guarde en el mismo archivo pero debajo del rango anterior, por ejemplo el primer rango es de A:D y hasta la fila 26, entonces el segundo rango sera de E:H y tambien sera de 26 filas pero es necesario que lo ponga debajo del anterior y asi sucesivamente con el ultimo rango.
La pregunta 2 es, en lugar que el archivo lo guarde con el nombre temp.text, se podra que pida el nombre para el archivo?
Mil gracias y espero a ver sido claro con mi problema.
Saludos
Prueba con la siguiente para la pregunta 1
Sub net_users()
Dim archNum As Integer
Dim Datos As Variant
Dim i As Long
Datos = Range("A1", Range("D" & Rows.Count).End(xlUp)).Value2
'Mod.Por.DAM
d2 = Range("E1", Range("H" & Rows.Count).End(xlUp)).Value2
d3 = Range("I1", Range("L" & Rows.Count).End(xlUp)).Value2
archNum = VBA.FreeFile
Open ThisWorkbook.Path & Application.PathSeparator & "temp.txt" For Output As #archNum
j = 1
For i = LBound(Datos) To UBound(Datos)
Print #archNum, Datos(j, 1) & " " & Datos(j, 2) & " " & Datos(j, 3) & " " & Datos(j, 4)
j = j + 1
Next i
For i = LBound(d2) To UBound(d2)
Print #archNum, d2(i, 1) & " " & d2(i, 2) & " " & d2(i, 3) & " " & d2(i, 4)
j = j + 1
Next i
For i = LBound(d3) To UBound(d3)
Print #archNum, d3(i, 1) & " " & d3(i, 2) & " " & d3(i, 3) & " " & d3(i, 4)
j = j + 1
Next i
Close #archNum
End SubPara la pregunta 2, quieres seleccionar el nombre a abrir o quieres que siempre se abra el archivo temp.txt pero que se guarde con otro nombre?
Saludos. DAM
Muchas gracias, la macro funciona perfectamente.
Y para la pregunta 2 necesito que me deje escoger el nombre del archivo ya que el nombre ira variando.
Gracias
Prueba con esta.
Sub net_users()
Dim archNum As Integer
Dim Datos As Variant
Dim i As Long
Datos = Range("A1", Range("D" & Rows.Count).End(xlUp)).Value2
'Mod.Por.DAM
d2 = Range("E1", Range("H" & Rows.Count).End(xlUp)).Value2
d3 = Range("I1", Range("L" & Rows.Count).End(xlUp)).Value2
archNum = VBA.FreeFile
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Seleccione archivo"
.Filters.Clear
.Filters.Add "Todos los Archivos", "*.*"
.Filters.Add "Archivos txt", "*.txt"
.FilterIndex = 2
.AllowMultiSelect = False
.InitialFileName = ThisWorkbook.Path
If .Show Then
atxt = .SelectedItems.Item(1)
archtxt = Mid(atxt, InStrRev(atxt, "\") + 1)
Else
Exit Sub
End If
End With
'Open ThisWorkbook.Path & Application.PathSeparator & "temp.txt" For Output As #archNum
Open ThisWorkbook.Path & Application.PathSeparator & archtxt For Output As #archNum
j = 1
For i = LBound(Datos) To UBound(Datos)
Print #archNum, Datos(j, 1) & " " & Datos(j, 2) & " " & Datos(j, 3) & " " & Datos(j, 4)
j = j + 1
Next i
For i = LBound(d2) To UBound(d2)
Print #archNum, d2(i, 1) & " " & d2(i, 2) & " " & d2(i, 3) & " " & d2(i, 4)
j = j + 1
Next i
For i = LBound(d3) To UBound(d3)
Print #archNum, d3(i, 1) & " " & d3(i, 2) & " " & d3(i, 3) & " " & d3(i, 4)
j = j + 1
Next i
Close #archNum
End Sub Saludos.DAM
Si es lo que necesitas.
Gracias por tu ayuda
Perdón, pero creo que no fui muy claro, te pido una disculpa, al correr la macro abre una ventana para abrir un archivo y lo que necesito es que lo guarde desde cero, que el archivo sea creado y que yo escoja el nombre para guardar el archivo de texto.
Saludos
Ah, prueba esta
Sub net_users()
Dim archNum As Integer
Dim Datos As Variant
Dim i As Long
Datos = Range("A1", Range("D" & Rows.Count).End(xlUp)).Value2
'Mod.Por.DAM
d2 = Range("E1", Range("H" & Rows.Count).End(xlUp)).Value2
d3 = Range("I1", Range("L" & Rows.Count).End(xlUp)).Value2
archNum = VBA.FreeFile
atxt = InputBox("Escribe el nombre del archivo txt: ")
If atxt = "" Then Exit Sub
If Right(atxt, 4) <> ".txt" Then atxt = atxt & ".txt"
Open ThisWorkbook.Path & Application.PathSeparator & atxt For Output As #archNum
j = 1
For i = LBound(Datos) To UBound(Datos)
Print #archNum, Datos(j, 1) & " " & Datos(j, 2) & " " & Datos(j, 3) & " " & Datos(j, 4)
j = j + 1
Next i
For i = LBound(d2) To UBound(d2)
Print #archNum, d2(i, 1) & " " & d2(i, 2) & " " & d2(i, 3) & " " & d2(i, 4)
j = j + 1
Next i
For i = LBound(d3) To UBound(d3)
Print #archNum, d3(i, 1) & " " & d3(i, 2) & " " & d3(i, 3) & " " & d3(i, 4)
j = j + 1
Next i
Close #archNum
End SubSaludos.DAM
Si es lo que necesitas.
