¿Cómo copiar si el criterio es igual al nombre de la hoja?
Tengo una hoja llamada "Resumen" en la cual manejo 3 productos:Magna, Premium, Diesel, el nombre del producto se encuentra en la "columna D" pero deseo separarlos, entonces abrí 3 hojas con el nombre de cada producto, intente hacer la macro para separarlos, pero me da " Error de compilación :El uso de la propiedad no es válido"
El pegado de los datos inicia a partir de la Fila 8 en todos los casos
Sub lecturas()
Dim hresumen As Worksheet
Dim hmagna As Worksheet
Dim hpremiun As Worksheet
Dim hdiesel As Worksheet
Set hresumen = Sheets("Resumen")
Set hmagna = Sheets("Magna")
Set hpremiun = Sheets("premiun")
Set hdiesel = Sheets("diesel")
Ini = D8
fin = Range("D" & Rows.Count).End(xlUp).Row
u1 = 8
u2 = 8
u3 = 8
For i = 8 To fin
If Range(Ini).Offset(i).Value = "Magna" Then
hresumen.Range("A" & i & ",B" & i & ",c" & i & ",D" & i & ",E" & i & ",F" & i & ",G" & i & ",H" & i & ",I" & i & ",j" & i & ",K" & i & ",L" & i & ",M" & i & ",N" & i & ",O" & i & ",P" & i & ",Q" & i & ",R" & i & ",s" & i & ",T" & i & ",U" & i & ",V" & i & ",W" & i & ",X" & i & ",Y" & i & ",Z" & i & ",AA" & i & ",AB" & i & ",AC" & i & ",AD" & i & ",AE" & i & ",AF" & i & ",AG" & i & ",AH" & i).Copy
hmagna.Range ("A" & i & ",B" & i & ",c" & i & ",D" & i & ",E" & i & ",F" & i & ",G" & i & ",H" & i & ",I" & i & ",j" & i & ",K" & i & ",L" & i & ",M" & i & ",N" & i & ",O" & i & ",P" & i & ",Q" & i & ",R" & i & ",s" & i & ",T" & i & ",U" & i & ",V" & i & ",W" & i & ",X" & i & ",Y" & i & ",Z" & i & ",AA" & i & ",AB" & i & ",AC" & i & ",AD" & i & ",AE" & i & ",AF" & i & ",AG" & i & ",AH" & i)
If Range(Ini).Offset(i).Value = "Premiun" Then
hresumen.Range("A" & i & ",B" & i & ",c" & i & ",D" & i & ",E" & i & ",F" & i & ",G" & i & ",H" & i & ",I" & i & ",j" & i & ",K" & i & ",L" & i & ",M" & i & ",N" & i & ",O" & i & ",P" & i & ",Q" & i & ",R" & i & ",s" & i & ",T" & i & ",U" & i & ",V" & i & ",W" & i & ",X" & i & ",Y" & i & ",Z" & i & ",AA" & i & ",AB" & i & ",AC" & i & ",AD" & i & ",AE" & i & ",AF" & i & ",AG" & i & ",AH" & i).Copy
hpremiun.Range ("A" & i & ",B" & i & ",c" & i & ",D" & i & ",E" & i & ",F" & i & ",G" & i & ",H" & i & ",I" & i & ",j" & i & ",K" & i & ",L" & i & ",M" & i & ",N" & i & ",O" & i & ",P" & i & ",Q" & i & ",R" & i & ",s" & i & ",T" & i & ",U" & i & ",V" & i & ",W" & i & ",X" & i & ",Y" & i & ",Z" & i & ",AA" & i & ",AB" & i & ",AC" & i & ",AD" & i & ",AE" & i & ",AF" & i & ",AG" & i & ",AH" & i)
Else
hresumen.Range("A" & i & ",B" & i & ",c" & i & ",D" & i & ",E" & i & ",F" & i & ",G" & i & ",H" & i & ",I" & i & ",j" & i & ",K" & i & ",L" & i & ",M" & i & ",N" & i & ",O" & i & ",P" & i & ",Q" & i & ",R" & i & ",s" & i & ",T" & i & ",U" & i & ",V" & i & ",W" & i & ",X" & i & ",Y" & i & ",Z" & i & ",AA" & i & ",AB" & i & ",AC" & i & ",AD" & i & ",AE" & i & ",AF" & i & ",AG" & i & ",AH" & i).Copy
hdiesel.Range ("A" & i & ",B" & i & ",c" & i & ",D" & i & ",E" & i & ",F" & i & ",G" & i & ",H" & i & ",I" & i & ",j" & i & ",K" & i & ",L" & i & ",M" & i & ",N" & i & ",O" & i & ",P" & i & ",Q" & i & ",R" & i & ",s" & i & ",T" & i & ",U" & i & ",V" & i & ",W" & i & ",X" & i & ",Y" & i & ",Z" & i & ",AA" & i & ",AB" & i & ",AC" & i & ",AD" & i & ",AE" & i & ",AF" & i & ",AG" & i & ",AH" & i)
Next
u1 = u1 + 1
u2 = u2 + 1
u3 = u3 + 1
End If
End If
End If
End Sub
2 Respuestas
Te anexo la macro
Sub SeparaCombustible()
'Por.Dante Amor
Set h1 = Sheets("Resumen")
For i = 1 To h1.Range("D" & Rows.Count).End(xlUp).Row
Select Case LCase(h1.Cells(i, "D"))
Case "magna": Set h2 = Sheets("magna")
Case "premiun": Set h2 = Sheets("premiun")
Case "diesel": Set h2 = Sheets("diesel")
Case Else: Set h2 = Nothing
End Select
If Not h2 Is Nothing Then
u = h2.Range("D" & Rows.Count).End(xlUp).Row + 1
If u < 8 Then u = 8
h1.Range("A" & i & ":AH" & i).Copy h2.Range("A" & u)
End If
Next
MsgBox "Fin"
End Sub
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
Esto te puede servir:
Public ultima As Integer
Sub separarl()
Dim hresumen As Worksheet
Dim hmagna As Worksheet
Dim hpremium As Worksheet
Dim hdiesel As Worksheet
Dim cass As Worksheet
Set hresumen = Sheets("Resumen")
Set hmagna = Sheets("Magna")
Set hpremium = Sheets("Premium")
Set hdiesel = Sheets("Diesel")
hresumen.Activate
hresumen.Range("d8").Select
ultima = ActiveCell.End(xlDown).Row
For i = 8 To ultima
hresumen.Activate
Range("D" & i).Select
Selection.EntireRow.Copy
Select Case Range("D" & i).Value
Case "Magna"
Set cass = hmagna
Call pega(cass)
Case "Premium"
Set cass = hpremium
Call pega(cass)
Case "Diesel"
Set cass = hdiesel
Call pega(cass)
End Select
Next
End Sub
Sub pega(ByVal cass As Worksheet)
cass.Select
Range("d9").Select
For p = 9 To ultima
Range("d" & p).Select
If Selection.Value = "" Then
Range("A" & p).PasteSpecial xlPasteAll
GoTo nest
End If
Next
nest:
End Sub
Ya lo probé pero no lo hace
Vaya, yo lo he probado así y ha funcionado.. ¿puedes indicar cómo se está comportando o dónde te da error?
¿Tienes algún correo para enviártelo?