Necesito corregir macro de extracción de datos
Tengo la siguiente macro:
Sub resumen()
Sheets("TOTAL TIENDAS"). Activate
Range("A1:K15000"). ClearContents
For x = 5 To 14
Sheets(x).Select
Range("a1:f" & Range("a65000").End(xlUp).Row).Copy
Sheets("TOTAL TIENDAS").Range("a65000").End(xlUp).Offset(0, 0).PasteSpecial Paste:=xlValues
Next
Sheets("TOTAL TIENDAS").Select
Range("A1").Select
Do While Not IsEmpty(ActiveCell)
x = WorksheetFunction.CountIf(Range("A:A"), ActiveCell)
If x > 1 Then
ActiveCell.EntireRow.Delete
Else
ActiveCell.Offset(1, 0).Select
End If
Loop
Sheets("Portada").Select
End SubMi problema es que la última fila de cada una de las hojas no me la copia, ¿qué es lo que tengo que cambiar para que me lo copie?
Respuesta de Dante Amor
1
H o l a : La macro si está copiando la última línea, lo que pasa es que la información de la siguiente hoja está sobreescribiendo la última fila de la hoja anterior, es por eso que no la ves.
Cambia en tu macro esta línea
Sheets("TOTAL TIENDAS"). Range("a65000").End(xlUp).Offset(0, 0).PasteSpecial Paste:=xlValuesPor esta
Sheets("TOTAL TIENDAS"). Range("a65000").End(xlUp).Offset(1, 0). PasteSpecial Paste:=xlValuesLe hice unos ajustes a tu macro, quedaría así:
Sub resumen()
'Act.Por.Dante Amor
Set h = Sheets("TOTAL TIENDAS")
h.Cells.ClearContents
For x = 5 To 6
Sheets(x).Range("A1:F" & Sheets(x).Range("a65000").End(xlUp).Row).Copy
h.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
Next
h.Rows(1).Delete
Sheets("TOTAL TIENDAS").Select
Range("A1").Select
Do While Not IsEmpty(ActiveCell)
x = WorksheetFunction.CountIf(Range("A:A"), ActiveCell)
If x > 1 Then
ActiveCell.EntireRow.Delete
Else
ActiveCell.Offset(1, 0).Select
End If
Loop
Sheets("Portada").Select
End SubPero hay algo que no entiendo. Realmente no sé para que es la segunda parte:
Sheets("TOTAL TIENDAS").Select
Range("A1").Select
Do While Not IsEmpty(ActiveCell)
x = WorksheetFunction.CountIf(Range("A:A"), ActiveCell)
If x > 1 Then
ActiveCell.EntireRow.Delete
Else
ActiveCell.Offset(1, 0).Select
End If
LoopMe imagino que quieres borrar duplicados o algo así. Pero en la forma que lo tienes no me funciona, pero si a ti te funciona, entonces ocupa la macro actualizada.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
