Doubt about VBA in relation to copy data from one sheet to another one


New Member
Mar 6, 2020
Office Version
  1. 365
I have some identifiers such as "A00015" in the sheet called "UPC CECL template". The macro has to take this identifier, then go to the sheet called "Preliminary instrument risk" and look for that identifiers. Once the program finds the value it will take every value and copy the range to paste it in other sheet called "Insurance instrumentRiskM csv".

The main issue is that I have the same identifier duplicated, so, it should take the same range and copy this range below the first one BUT adding a "n" that starts from 2 to any other. A00015, A200015, A300015... once this is done it should change the "A" for "I".

I have two problems: the first one is I have a problem when pasting on the "Insurance instrumentRiskM csv" (I think this is because the only thing that this sheet has is the tittle) it happens in this line "ActiveCell.End(xlDown).Offset(1, 0).Select" after var3.

The second one is that I can't add this "n" to the data duplicated.

Could you please help me?


VBA Code:
Sub Probando()
' Probando Macro
Dim cell_comp As Object, celda1 As Object, celda2 As Object
Dim a As Long, b As Long, c As Long, d As Long, e As Long, final_lista As Long
Dim piv As Range, rango1 As Range, rango2 As Range, rango3 As Range, rango4 As Range
Dim buscar As String, var1 As String, var2 As String, var3 As String, sup As String, inf As String

' Le indico el primer valor que voy a buscar:
Sheets("UCP CECL template").Select

    final_lista = Range("A3").End(xlDown).Row
    Set rango1 = Range("A3:A" & final_lista)
' Es importante que los códigos se hayan ordenado ya sea ascendente o descendentemente, de lo contrario se pueden generar errores en la asignación de los números que van tras la letra e indican repetición del código.
    For Each cell_comp In rango1

    Set piv = ActiveCell
    buscar = ("00000" & piv.Value)
' Me voy a la hoja donde quiero buscarlo y le indico en qué celda:
Sheets("Preliminary instrumentRiskM csv").Select
    a = 0
    Do Until ActiveCell.Value = Empty
    Range("A" & (2 + a)).Select
    var1 = VBA.Mid(ActiveCell.Value, 2, 15)
    If buscar <> var1 Then
        ActiveCell.Offset(1, 0).Select
        ElseIf buscar = var1 Then
        Set rango2 = ActiveCell
        sup = ActiveCell.Value
        inf = ActiveCell.Value
        Do Until sup <> inf
        ActiveCell.Offset(1, 0).Select
        inf = ActiveCell.Offset(1, 0).Value
        ' ActiveCell.Offset(-1, 1).Value = inf
        Set rango3 = ActiveCell
        a = a + 1
            b = rango2.Row
            c = rango3.Row
            Range("A" & b & ":A" & c).Select
            Range(Selection, Selection.Offset(0, 30)).Select
            Sheets("Insurance instrumentRiskM csv").Select
            ' Utilizo "var2" para grabar auxiliarmente el último
            var2 = ActiveCell.End(xlDown).Value
            ' Definir el rango para el que voy a ejecutar el foreach como el rango desde donde inició hasta donde terminó la copia:
            var3 = ActiveCell.End(xlDown).Value
            ActiveCell.End(xlDown).Offset(1, 0).Select
            d = ActiveCell.Row
            Set rango4 = Range("A" & d & ":A" & ActiveCell.End(xlDown).Row)
                ' Aquí instruiré que si los códigos no son iguales, solo reemplace por I.
                    If var3 <> rango3.Value Then
                    For Each celda1 In rango4
                    rango4.Replace What:=VBA.Mid(ActiveCell.Value, 1, 1), Replacement:="I", SearchOrder:=xlByColumns, MatchCase:=True
                ' Aquí instruiré que si los códigos son iguales, entonces reemplace por I más el ordenador (número asignado al grupo, según se copia, y que inicia en 2).
                    ElseIf var3 = rango3.Value Then
                    For Each celda2 In rango4
                    rango4.Replace What:=VBA.Mid(ActiveCell.Value, 1, 1), Replacement:="I" & e, SearchOrder:=xlByColumns, MatchCase:=True

                    MsgBox "Error, please order Project ACBS facility ID in UCP CECL template sheet by ascendant/descendant before execute the macro"
                    End If
            Sheets("Preliminary instrumentRiskM csv").Select
        ActiveCell.Offset(1, 0).Select
    End If
    a = a + 1
    Sheets("UCP CECL template").Select
End Sub

Some videos you may like

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.


Well-known Member
Sep 10, 2010
Office Version
  1. 2013
  1. Windows
Hi there, welcome to the board!
A few remarks:
I have some identifiers such as "A00015" in the sheet ....
- I have run your code but could not figure out the EXACT format of the used identifiers. Since you're using a couple of zeros as a prefix in the to-search-for string the find condition is never met ...
VBA Code:
buscar = ("00000" & piv.Value)
- whenever this find issue is ignored, your code does copy the row of the found ID as well as the adjacent row below and targets the last empty two rows on the target sheet;
- the Replace method of a range targets the whole range, so the For Each Next is superfluous
- the Replace function can be used to add the desired extra number Replace("A00015","A","A2") results in A200015
- there are rather a lot of Select statements; in VBA this is usually not necessary; to target a range you might use the Set statement; you even can target a range on another sheet than the ActiveSheet; note the preceding dots of the Range statements in case the With-End With is used:
example 1
VBA Code:
final_lista = Sheets("UCP CECL template").Range("A3").End(xlDown).Row
Set rango1 = Sheets("UCP CECL template").Range("A3:A" & final_lista)
example 2
VBA Code:
With Sheets("UCP CECL template")
    Set rango1 = .Range("A3:A" & .Range("A3").End(xlDown).Row)
End With
You might consider to post a fragment of all of your three Worksheets as well as the desired outcome.

Watch MrExcel Video

Forum statistics

Latest member

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back