Simplificar macro que copia rangos de distintas hojas a una sola.

Tengo una macro que hice yo sacando un poco de info de varios lados. El objetivo es el siguiente.

Si de la hoja "acciones" la celda

B2 <> ""; copiar y pegar en la hoja "Historico" el rango "reco1bata"

B3 <> ""; copiar y pegar en la hoja "Historico" el rango "reco1bata" y "reco2bata"

B4 <> ""; copiar y pegar en la hoja "Historico" el rango "reco1bata", "reco2bata" y "reco3bata"

Así hasta llegar a B9 y "reco8bata". Si uno está vacío, debería terminar ahí.

Cuestión que los rangos esos están en distintas hojas y yo no se mucho de macros así que hice como si fuese una macro por cada paso. Me gustaría saber si puede simplificarla y de paso aprendo mas sobre macros. Aquí dejo lo que hice:

Sub bata()
If Sheets("ACCIONES").Range("B2").Value <> "" Then
 Range("reco1bata").Copy
 Sheets("Historico").Select
 Range("D1").End(xlDown).Offset(1, 0).Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
ElseIf Sheets("ACCIONES").Range("B2").Value = "" Then
MsgBox "Verifique las tildes de las Checkbox", vbCritical, "ATENTI_PISCUI"
End If
If Sheets("ACCIONES").Range("B3").Value <> "" Then
 Range("reco2bata").Copy
 Sheets("Historico").Select
 Range("D1").End(xlDown).Offset(1, 0).Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End If
If Sheets("ACCIONES").Range("B4").Value <> "" Then
 Range("reco3bata").Copy
 Sheets("Historico").Select
 Range("D1").End(xlDown).Offset(1, 0).Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End If
If Sheets("ACCIONES").Range("B5").Value <> "" Then
 Range("reco4bata").Copy
 Sheets("Historico").Select
 Range("D1").End(xlDown).Offset(1, 0).Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End If
If Sheets("ACCIONES").Range("B6").Value <> "" Then
 Range("reco5bata").Copy
 Sheets("Historico").Select
 Range("D1").End(xlDown).Offset(1, 0).Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End If
If Sheets("ACCIONES").Range("B7").Value <> "" Then
 Range("reco6bata").Copy
 Sheets("Historico").Select
 Range("D1").End(xlDown).Offset(1, 0).Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End If
If Sheets("ACCIONES").Range("B8").Value <> "" Then
 Range("reco7bata").Copy
 Sheets("Historico").Select
 Range("D1").End(xlDown).Offset(1, 0).Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End If
If Sheets("ACCIONES").Range("B9").Value <> "" Then
 Range("reco8bata").Copy
 Sheets("Historico").Select
 Range("D1").End(xlDown).Offset(1, 0).Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End If
End Sub

Añade tu respuesta

Haz clic para o