Lista de conceptos e importes sumados
Tengo una hoja de cálculo en excel 2007 en la que figuran, conceptos (columna B) e importe Columna C, la columna A se maraca con una X para que vaya sumando en una celda el coste total de los conceptos marcados (celda H2), lo que quisiera es que una vez que están todos los conceptos marcados con sus X y el importe sumado se me copie en otra hoja (ej facturación) la relación de conceptos con su importe correspondiente y el total, algo parecido a esto
X VELOCIDAD DE SEDIMENTACION GLOBULAR 0,76
X HEMOGRAMA CON VSG 2,88
X GLUCEMIA BASAL 0,89
X ##SISTEMATICO DE ORINA 1,48
total 6.01
Nº de parámetros 4
1 Respuesta
Te anexo la macro. Cambia en la macro "hoja1" y "facturacion" por los nombres de tus hojas.
Sub factura()
'Por.Dante Amor
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("facturacion")
'
h2.Cells.ClearContents
j = 2
n = 0
'
For i = 1 To h1.Range("A" & Rows.Count).End(xlUp).Row
If h1.Cells(i, "A") = "X" Then
h1.Range("A" & i & ":C" & i).Copy h2.Cells(j, "A")
j = j + 1
n = n + 1
End If
Next
'
If n > 0 Then
h2.Cells(j + 1, "B") = "Total"
h2.Cells(j + 1, "C") = h1.Range("H2")
h2.Cells(j + 3, "B") = "Nº de parámetros "
h2.Cells(j + 3, "C") = n
End If
'
End SubSaludos.Dante Amor
No olvides valorar la respuesta.
Dante muchísimas gracias por tu macro, me da un error "subíndice fuera de rango", te podría mandar el libro de excel completo para que lo vieras, pero no encuentro opción de adjuntar ficheros.
Era un error mío al copiar el código, te muestro como sale el resultado.
Como verás no realiza la suma de los conceptos.
De todas formas te estoy muy agradecido y si pudieramos copiar el nombre del paciente que iría en la primera columna de la hoja ya sería perfecto.
Si no puede ser de todas formas pienso darte la máxima puntuación.
Según tus indicaciones el total está en la celda H2 de la hoja1. Si no tienes en esa celda el total no te va a copiar nada.
Por otra parte, sí puedo copiar el nombre del paciente, pero necesito que me digas en dónde lo tienes, puedes poner las imágenes de cómo tienes tu información y cómo la quieres.
O envíame tu archivo, de igual forma en la hoja "facturación" pon el ejemplo de cómo lo quieres y adapto la macro.
Mi correo: [email protected]
En el asunto del correo pon tu nombre: doctorjlcr
Te envié el archivo con la macro
Sub FacturaSocios()
'Por.Dante Amor
Set h1 = Sheets("FuenteAlamoSocios")
Set h2 = Sheets("FacturaSocios")
'
u = h2.UsedRange.Rows(h2.UsedRange.Rows.Count).Row
If u < 2 Then u = 2
h2.Range("A2:D" & u).ClearContents
j = 2
n = 0
'
For i = 3 To h1.Range("A" & Rows.Count).End(xlUp).Row
If UCase(h1.Cells(i, "A")) = "X" Then
h1.Range("A" & i & ":C" & i).Copy h2.Cells(j, "A")
h2.Cells(j, "A") = h1.Range("B1")
j = j + 1
n = n + 1
End If
Next
'
If n > 0 Then
h2.Cells(j + 1, "B") = "Total"
h2.Cells(j + 1, "C") = h1.Range("D3")
h2.Cells(j + 3, "B") = "Nº de parámetros "
h2.Cells(j + 3, "C") = n
h1.Range("A3:A" & h1.Range("A" & Rows.Count).End(xlUp).Row).ClearContents
End If
'
h2.Select
MsgBox "Factura Socios terminada", vbInformation
End SubRecuerda valorar la respuesta
