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

hfabiant

New Member
Joined
Mar 6, 2020
Messages
1
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?

THANK YOU SO MUCH

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
Range("A3").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
    cell_comp.Select

    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
    
    Range("A2").Select
    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
        Loop
            
            b = rango2.Row
            c = rango3.Row
            Range("A" & b & ":A" & c).Select
            Range(Selection, Selection.Offset(0, 30)).Select
            Selection.Copy
            
            Sheets("Insurance instrumentRiskM csv").Select
            Range("A2").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
            ActiveSheet.Paste
            Selection.Select
            ActiveCell.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
                    Next
                
                ' 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
                    Next

                    Else
                    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
            rango3.Select
        
        Else
        ActiveCell.Offset(1, 0).Select
        
    End If
        
    a = a + 1
    Loop
    
    Sheets("UCP CECL template").Select
    Next
    
End Sub
 

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.
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.
 
Upvote 0

Forum statistics

Threads
1,214,905
Messages
6,122,178
Members
449,071
Latest member
cdnMech

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 MrExcel.com.
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 "mrexcel.com".
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
Back
Top