Crear archivos masivos en excel

Puedes poner imágenes con todo el detalles que se requiere. Si son datos confidenciales, reemplázalos con datos genéricos.

Observa cómo debes poner un ejemplo:

Nota: Una cosa que debes tener en cuenta cuando haces una pregunta en un foro de excel. Las personas a las que solicitas ayuda no saben nada acerca de tus datos, nada sobre cómo están en el libro de trabajo y nada sobre cómo quieres el resultado. Debes ser muy específico al describir cada una de estas áreas; y no debes suponer que seremos capaces de "resolverlo" por nuestra cuenta. Recuerda, nos estás pidiendo ayuda. Así que ayúdanos, brindando la información que necesitamos para hacerlo, incluso si esa información te parece "obvia" (recuerda, sólo es obvia para ti porque estás familiarizado con tus datos, su diseño y el objetivo general para ellos).

¡Gracias!

Mira los datos deben pasar de la imagen 1 (que es un archivo con el listado)

a la imagen 2 (que es la plantilla de la nota crédito)

Y que cada archivo quede guardado con el nombre de la factura

Tal vez no viste bien mi ejemplo.

Tus imágenes deben contener lo siguiente:

Deben verse las filas, las columnas, el encabezado, el nombre de la hoja.

En la imagen 1 es de la columna A a la F

En la imagen 2 la factura va en la b11, documento en la b12 y el nombre en la b13. el concepto en la a15, la causa en la b15 y el valor en la c15, pero hay facturas que pueden tener varios item, es decir se repiten el concepto, la causa y el valor.

Como puedes ver en la imagen 1, es un listado y se debe guardar el archivo con el numero de la factura y debe ir en una carpeta diferente, es decir que esta en C pero cada factura tiene su carpeta

No has puesto el nombre de cada hoja.

Sería más fácil si pones imágenes.

Y debes poner un ejemplo de esto:

Hay facturas que pueden tener varios item

En la hoja de facturas pon un ejemplo donde una factura tenga varios item.

En la hoja plantilla pones cómo se verá esa factura.

Ambos ejemplos con imágenes.

Y falta más información, pero si no quieres proporcionarla, será difícil ayudarte...

Ambas son la Hoja1

ya te puse las imágenes

¿Cómo qué ambas son la hoja1?

¿Entonces tienes 2 libros?

Si son 2 libros, ¿cómo se llama cada libro?

Y en cuál carpeta se van a guardar cada archivo.

Te falta el ejemplo donde una factura tiene varios item.

Si, son dos libros, Uno se llama listado (Imagen 1) y el otro se llama nota crédito(Imagen 2)

Y cada archivo se guarda en

C:\2 BOMBEROS\BOMBEROS VOLUNTARIOS \1, por ejemplo porque como te digo cada factura tiene su carpeta y debe quedar la 1 en la 1, la 2 en la 2

Entonces, no es posible para ti poner un ejemplo donde una factura tenga varios item.

Prueba lo siguiente.

NOTA: los 2 libros deben estar abiertos.

Pon todo el código en un módulo y ejecuta la macro "Crear_Archivos"

Option Explicit
Sub Crear_Archivos()
'
'POR DANTE AMOR
'
  Dim wb1 As Workbook, wb2 As Workbook, wb3 As Workbook
  Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
  Dim i As Long, j As Long, lr As Long
  Dim ruta As String, fact As String, rutafin As String
  '
  'nombres de los 2 libros. LOS 2 LIBROS DEBEN ESTAR ABIERTOS
  Set wb1 = Workbooks("listado.xlsx")
  Set wb2 = Workbooks("nota crédito.xlsx")
  Set sh1 = wb1.Sheets("Hoja1")
  Set sh2 = wb2.Sheets("Hoja1")
  '
  ruta = "C:\2 BOMBEROS\BOMBEROS VOLUNTARIOS\"
  'ruta = "C:\trabajo\"
  '
  If Dir(ruta, vbDirectory) = "" Then
    MsgBox "No existe la carpeta :" & ruta
    Exit Sub
  End If
  '
  lr = sh1.Range("A" & Rows.Count).End(3).Row
  If lr = 1 Then Exit Sub
  '
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  '
  fact = sh1.Range("A" & 2).Value
  Call Libro_Ruta(sh2, wb3, sh3, ruta, fact)
  '
  j = 14
  For i = 2 To lr + 1
    If fact <> sh1.Range("A" & i).Value Then
      wb3.SaveAs rutafin & "\" & fact
      wb3.Close False
      '
      If sh1.Range("A" & i).Value = "" Then Exit For
      Call Libro_Ruta(sh2, wb3, sh3, ruta, sh1.Range("A" & i).Value)
      j = 15
    Else
      j = j + 1
    End If
    sh3.Range("B11").Value = sh1.Range("A" & i).Value
    sh3.Range("B12").Value = sh1.Range("B" & i).Value
    sh3.Range("B13").Value = sh1.Range("C" & i).Value
    '
    sh3.Range("A" & j).Value = sh1.Range("D" & i).Value
    sh3.Range("B" & j).Value = sh1.Range("E" & i).Value
    sh3.Range("C" & j).Value = sh1.Range("F" & i).Value
    '
    fact = sh1.Range("A" & i).Value
    rutafin = ruta & fact
  Next
  '
  Application.ScreenUpdating = True
  MsgBox "Fin"
End Sub
'
Sub Libro_Ruta(sh2 As Worksheet, wb3 As Workbook, sh3 As Worksheet, ruta As String, fact As String)
  Dim rutafin As String
  sh2.Copy
  Set wb3 = ActiveWorkbook
  Set sh3 = wb3.Sheets(1)
  rutafin = ruta & fact
  If Dir(rutafin, vbDirectory) = "" Then MkDir rutafin
End Sub

[No olvides valorar.

Gracias, excelente funciona bien

Pero crea las carpetas y las carpetas ya están creadas, la idea es que las macro la ubique en las carpetas.

Y el valor lo esta trayendo con un decimal de más

Por lo demás esta perfecto

El valor lo puedes acomodar con el formato en la hoja "nota de crédito", la macro solamente pasa el valor de un lado a otro, no modifica nada.

Si la carpeta ya está creada, solamente pone el archivo, si no existe la carpeta entonces la crea, es un plus de la macro.

¡Gracias! 

Mira como esta creando la carpeta

Puse una carpeta PRUEBA y los crea con esa palabra antes, por eso no los esta ubicando en la carpeta corresponde, me puedes ayudar para verificar que estoy haciendo de manera incorrecta.

Adicionalmente me puedes ayudar para poner valor en letras del valor aceptado y que quede guardado en PDF.

De nuevo Gracias

No es clara tu imagen, se ve muy pequeña.

Así es como debes poner tu carpeta inicial:

ruta = "C:\2 BOMBEROS\BOMBEROS VOLUNTARIOS\"

Dentro de esa carpeta va a crear las subcarpetas 1, 2, 3, etc...

Esta es la carpeta donde debe quedar

y asi queda

Es decir no esta quedando en la carpeta que es y esta creando todos los archivos en nuevas carpetas

Puedes poner aquí el código modificado.

Quiero ver cómo lo dejaste.

También escribe aquí en cuál carpeta debe quedar. Porque tú pusiste esto:

C:\2 BOMBEROS\BOMBEROS VOLUNTARIOS \

Es por eso que debes poner la información real.

Sub Crear_Archivos()
'
'POR DANTE AMOR
'
Dim wb1 As Workbook, wb2 As Workbook, wb3 As Workbook
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
Dim i As Long, j As Long, lr As Long
Dim ruta As String, fact As String, rutafin As String
'
'nombres de los 2 libros. LOS 2 LIBROS DEBEN ESTAR ABIERTOS
Set wb1 = Workbooks("listado.xlsx")
Set wb2 = Workbooks("NOTA CREDITO.xlsm")
Set sh1 = wb1.Sheets("Hoja1")
Set sh2 = wb2.Sheets("Hoja1")
'
ruta = "P:\2 BOMBEROS\BOMBEROS VOLUNTARIOS DE YOPAL\ADRES\GLOSAS\27007 PROCESAR\Paquete ASEGURADAS PROCESAR"
'
'
If Dir(ruta, vbDirectory) = "" Then
MsgBox "No existe la carpeta :" & ruta
Exit Sub
End If
'
lr = sh1.Range("A" & Rows.Count).End(3).Row
If lr = 1 Then Exit Sub
'
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'
fact = sh1.Range("A" & 2).Value
Call Libro_Ruta(sh2, wb3, sh3, ruta, fact)
'
j = 14
For i = 2 To lr + 1
If fact <> sh1.Range("A" & i).Value Then
wb3.SaveAs rutafin & "\" & fact
wb3.Close False
'
If sh1.Range("A" & i).Value = "" Then Exit For
Call Libro_Ruta(sh2, wb3, sh3, ruta, sh1.Range("A" & i).Value)
j = 15
Else
j = j + 1
End If
sh3.Range("B11").Value = sh1.Range("A" & i).Value
sh3.Range("B12").Value = sh1.Range("B" & i).Value
sh3.Range("B13").Value = sh1.Range("C" & i).Value
'
sh3.Range("A" & j).Value = sh1.Range("D" & i).Value
sh3.Range("B" & j).Value = sh1.Range("E" & i).Value
sh3.Range("C" & j).Value = sh1.Range("F" & i).Value
'
fact = sh1.Range("A" & i).Value
rutafin = ruta & fact
Next
'
Application.ScreenUpdating = True
MsgBox "Archivos Generados"
End Sub
'
Sub Libro_Ruta(sh2 As Worksheet, wb3 As Workbook, sh3 As Worksheet, ruta As String, fact As String)
Dim rutafin As String
sh2.Copy
Set wb3 = ActiveWorkbook
Set sh3 = wb3.Sheets(1)
rutafin = ruta & fact
If Dir(rutafin, vbDirectory) = "" Then MkDir rutafin
End Sub

Hola, ya lo logré

Es posible que quede guardado en PDF y no en Excel?

Y como puedo hacer para que guarde el valor en letras