Copiar un rango de celdas si valor es igual

Sub Copiar_mes()
Dim x As Integer
Application.ScreenUpdating = False
With Sheets("BASED")
If .[a1] = "ENERO" Then _
Range("B2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range("B2:AF4").Select
Selection.Copy
Range("B13").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Else
If .[a1] = "FEBRERO" Then _
Range("B2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range("B2:AF4").Select
Selection.Copy
Range("B17").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Else
If .[a1] = "MARZO" Then _
Range("B2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range("B2:AF4").Select
Selection.Copy
Range("B21").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Else
If .[a1] = "ABRIL" Then _
Range("B2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range("B2:AF4").Select
Selection.Copy
Range("B25").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Else
If .[a1] = "MAYO" Then _
Range("B2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range("B2:AF4").Select
Selection.Copy
Range("B29").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Else
If .[a1] = "JUNIO" Then _
Range("B2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range("B2:AF4").Select
Selection.Copy
Range("B33").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Else
If .[a1] = "JULIO" Then _
Range("B2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range("B2:AF4").Select
Selection.Copy
Range("B37").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Else
If .[a1] = "AGOSTO" Then _
Range("B2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range("B2:AF4").Select
Selection.Copy
Range("B41").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Else
If .[a1] = "SEPTIEMBRE" Then _
Range("B2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range("B2:AF4").Select
Selection.Copy
Range("B45").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Else
If .[a1] = "OCTUBRE" Then _
Range("B2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range("B2:AF4").Select
Selection.Copy
Range("B49").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Else
If .[a1] = "NOVIEMBRE" Then _
Range("B2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range("B2:AF4").Select
Selection.Copy
Range("B53").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Else
If .[a1] = "DICIEMBRE" Then _
Range("B2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range("B2:AF4").Select
Selection.Copy
Range("B57").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
End With
Next
Sheets("BASED").[a1].Select
Application.ScreenUpdating = True
End Sub

Añade tu respuesta

Haz clic para o