Buenas noches, estoy intentando crear una macro que haga lo siguiente:
Tengo 3 grupos de celdas. Lo que quiero hacer es que al seleccionar celdas de uno de los tres grupos, copie los valores de las celdas seleccionadas y los pegue en la Hoja2 de forma ordenada y que además reconozca de qué grupo es y pegue el grupo al que pertenece en la cuarta celda de la fila que copia.
El caso es que al ejecutarlo con el primer grupo funciona perfectamente, salvo que en la fila D donde quiero que me pegue el grupo, me sobreescribe los valores de grupo.
Buenas noches, estoy intentando crear una macro que haga lo siguiente:
Tengo 3 grupos de celdas. Lo que quiero hacer es que al seleccionar celdas de uno de los tres grupos, copie los valores de las celdas seleccionadas y los pegue en la Hoja2 de forma ordenada y que además reconozca de qué grupo es y pegue el grupo al que pertenece en la cuarta celda de la fila que copia.
El caso es que al ejecutarlo con el primer grupo funciona perfectamente, salvo que en la fila D donde quiero que me pegue el grupo, me sobreescribe los valores de grupo.
Este es el código:
Sub Macro3()
Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, 2)).Select
Selection.Copy
Workbooks.Open ("C:\Users\juanjosé\Desktop\1.xlsx")
Workbooks("1").Sheets("Hoja1").Range("A1").Select
ActiveSheet.Range("A1").End(xlDown).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks("1").Save
Workbooks("1").Close
Application.CutCopyMode = False
If Intersect(ActiveCell.Offset(0, 0), Range("A1:C3")) Is Nothing Then
MsgBox "No pertenece al Grupo A"
Else: Range("B5").Copy
Workbooks.Open ("C:\Users\juanjosé\Desktop\1.xlsx")
Workbooks("1").Sheets("Hoja1").Range("D1").Select
ActiveSheet.Range("D1").End(xlDown).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks("1").Save
Workbooks("1").Close
Application.CutCopyMode = False
End If
If Intersect(ActiveCell.Offset(0, 0), Range("D1:F3")) Is Nothing Then
MsgBox "No pertenece al Grupo B"
Else: Range("E5").Copy
Workbooks.Open ("C:\Users\juanjosé\Desktop\1.xlsx")
Workbooks("1").Sheets("Hoja1").Range("D1").Select
ActiveSheet.Range("D1").End(xlDown).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks("1").Save
Workbooks("1").Close
Application.CutCopyMode = False
End If
End Sub
Adjunto los archivos excel también.
Saludos y gracias.
Archivos.zip