0

I've been working on a VBA macro that copies values from two sheets into another one. I create a temporal sheet where I paste the values from one sheet and work with them cause where I have to paste them have more or fewer columns and I can't mess with the data of the sheet where I'm copying. Everything is ok till I paste. The sheet where I paste has data in it, some formulas, and stuff that I need to know.

This is my code, sorry is too big

Sub Actualiza_Cartera()

    Dim i, r, erow  As Integer
    Dim myUnion As Range
    Dim myCell As Object
    ReDim arrayNombre(1 To 4)

    arrayNombre(1) = "Forward EUR Fisico"
    arrayNombre(2) = "Forward EUR Comp"
    arrayNombre(3) = "Forward CNH"
    arrayNombre(4) = "Forward PEN"

'    Application.DisplayAlerts = False 'this is commented till this works
'    Application.ScreenUpdating = False

'    Limpia contenido sheet POR PLAZO
    Worksheets("Final_Sheet").Select
    last_col = Cells(7, Columns.Count).End(xlToLeft).Column     'Get last column
    last_row = Cells(Rows.Count, 2).End(xlUp).Row               'Get last row
    Range(Cells(7, 1), Cells(last_row, last_col - 1)).Select    'Seleccionar tabla
    Selection.ClearContents                                     'Borrar el contenido
    
'   crea página temp
    Sheets.Add.Name = "temp"

'   COPIA SID
'   activa, selecciona y copia tabla de Vigentes_SID
    Worksheets("Vigentes_SID").Select
    last_row = Cells(Rows.Count, 2).End(xlUp).Row                   'Get last row
    last_col = Cells(2, Columns.Count).End(xlToLeft).Column         'Get last column
    Range(Cells(2, 1), Cells(last_row, last_col)).Select            'Select entire table
    Selection.Copy                                                  'copia seleccion
    Sheets("temp").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False                                   'pega a temporal
    Application.CutCopyMode = False

'   comienza a formatear datos
    Range("E:F").Columns.Delete 'borra columnas que no se usarán

'    Reordena las columnas según el formato
    Columns("G:G").Cut
    Columns("C:C").Insert Shift:=xlToRight
    Columns("G:G").Cut
    Columns("F:F").Insert Shift:=xlToRight

'    Inserta columnas faltantes para la planilla de risk
    Columns(6).EntireColumn.Insert
    Columns(6).ClearFormats
'    Inserta columnas faltantes para la planilla de risk
    Columns(7).EntireColumn.Insert
    Columns(7).ClearFormats

'    Cambiar formato de columnas
    Columns("D:E").Select
    Selection.NumberFormat = "m/d/yyyy"
    Range("H:H, J:J").Select
    Selection.NumberFormat = "#,##0_ ;[Red]-#,##0 "
    Range("I:I").Select
    Selection.NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "

'    Rellena columnas agregadas en blanco
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "USD"
    LastRow = Range("E" & Rows.Count).End(xlUp).Row
    Range("F1").AutoFill Destination:=Range("F1:F" & LastRow), Type:=xlFillCopy

    Range("G1").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[1]<0,""V"",""C"")"
    LastRow = Range("H" & Rows.Count).End(xlUp).Row
    Range("G1").AutoFill Destination:=Range("G1:G" & LastRow), Type:=xlFillCopy

    Range("C1").Select
    ActiveCell.FormulaR1C1 = "=RC[2]-TODAY()"
    LastRow = Range("B" & Rows.Count).End(xlUp).Row
    Range("C1").AutoFill Destination:=Range("C1:C" & LastRow), Type:=xlFillCopy

'    Copia los datos llamados por la función a valores para no perderlos al eliminar columnas
    Range("G1").Select
    Range(Selection, Selection.End(xlDown)).Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

    Range("C1").Select
    Range(Selection, Selection.End(xlDown)).Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

'   Loop para seleccionar y eliminar corredora y facility
    For r = Sheets("temp").UsedRange.Rows.Count To 1 Step -1
        If Cells(r, "B") = "CORREDORA" Or InStr(Cells(r, "B").Value, "FACILITY") Then
'            Sheets("temp").Rows(r).EntireRow.Delete
             If Not myUnion Is Nothing Then
                 Set myUnion = Union(myUnion, Rows(r).EntireRow)
             Else
                 Set myUnion = Rows(r).EntireRow
             End If
        End If
    Next

    If myUnion Is Nothing Then
        ActiveSheet.Cells(1, 1).Select
    Else
        myUnion.Select
    End If
    Selection.Delete

'    copia datos de temp a por plazo
    last_row = Cells(Rows.Count, 2).End(xlUp).Row           'Get last row
    last_col = Cells(1, Columns.Count).End(xlToLeft).Column 'Get last column
    Range(Cells(1, 1), Cells(last_row, last_col)).Select    'seleccionar tabla
    Selection.Copy
    Sheets("Final_Sheet").Select
    Range("A7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Set myUnion = Nothing
    Sheets("temp").Select
    Cells.Clear

'   COPIA FORWARD

'   Loop copia y pega desde hojas Forward
    For i = LBound(arrayNombre) To UBound(arrayNombre)
        Worksheets(arrayNombre(i)).Select
        For r = Sheets(arrayNombre(i)).UsedRange.Rows.Count To 1 Step -1
            If IsDate(Cells(r, "A").Value) = True Then
    '           Sheets("temp").Rows(r).EntireRow.Delete
                If Not myUnion Is Nothing Then
                    Set myUnion = Union(myUnion, Rows(r).EntireRow)
                Else
                    Set myUnion = Rows(r).EntireRow
                End If
            End If
        Next

        If myUnion Is Nothing Then
            Cells(1, 1).Select
        Else
            myUnion.Select
            Selection.Copy
            Worksheets("temp").Select
            last_row = Sheets("temp").Cells(Rows.Count, 1).End(xlUp).Row
            If last_row = 1 Then
                Sheets("temp").Cells(last_row, 1).PasteSpecial Paste:=xlPasteValues
                Application.CutCopyMode = False
                last_col_aux = Sheets("temp").Cells(3, Columns.Count).End(xlToLeft).Column
                last_row_aux = Sheets("temp").Cells(Rows.Count, 2).End(xlUp).Row
                Sheets("temp").Range(Cells(last_row, last_col_aux + 1), Cells(last_row_aux, last_col_aux + 1)) = arrayNombre(i)
                Columns("S:S").Select
                Range(Selection, Selection.End(xlToRight)).Select
                Selection.Clear
            Else
                Sheets("temp").Cells(last_row + 1, 1).PasteSpecial Paste:=xlPasteValues
                Application.CutCopyMode = False
                last_col_aux = Sheets("temp").Cells(2, Columns.Count).End(xlToLeft).Column
                last_row_aux = Sheets("temp").Cells(Rows.Count, 2).End(xlUp).Row
                Sheets("temp").Range(Cells(last_row + 1, last_col_aux), Cells(last_row_aux, last_col_aux + 1)).Value = arrayNombre(i)
                Columns("S:S").Select
                Range(Selection, Selection.End(xlToRight)).Select
                Selection.Clear
            End If
            Set myUnion = Nothing
        End If
    Next i

'   Pone valor moneda
    Range("S1").Select
    ActiveCell.FormulaR1C1 = "=IF(OR(RC[-1]=""Forward EUR Fisico"",RC[-1]=""Forward EUR Comp""),""EUR"",IF(RC[-1]=""Forward CNH"",""CNH"",IF(RC[-1]=""Forward PEN"",""PEN"",""ERROR"")))"
    LastRow = Range("R" & Rows.Count).End(xlUp).Row
    Range("S1").AutoFill Destination:=Range("S1:S" & LastRow), Type:=xlFillCopy

    Range("S1").Select
    Range(Selection, Selection.End(xlDown)).Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

    Range("R:R").Columns.Delete

'   Reordenamiento de columnas
    Columns("J:J").Cut                      'folio
    Columns("A:A").Insert Shift:=xlToRight

    Columns("M:M").Cut                      'cliente
    Columns("B:B").Insert Shift:=xlToRight

    Columns("O:O").Cut                      'plazo
    Columns("C:C").Insert Shift:=xlToRight

    Columns("R:R").Cut                      'moneds
    Columns("F:F").Insert Shift:=xlToRight

    Range("G:G, K:K, M:P, R:S").Columns.Delete             'delete columnas no usadas

'   unifica precio
    Range("K:K").Columns.Insert Shift:=xlToRigh
    Range("K1").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-1]="""",RC[-2],RC[-1])"
    LastRow = Range("B" & Rows.Count).End(xlUp).Row
    Range("K1").AutoFill Destination:=Range("K1:K" & LastRow), Type:=xlFillCopy

    Range("K1").Select
    Range(Selection, Selection.End(xlDown)).Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

    Range("I:J").Columns.Delete

'   da formato a las fechas
    Columns("D:E").Select
    Selection.NumberFormat = "m/d/yyyy"


'   rellena con 1 si no tiene folilo
    Range("K:K").Columns.Insert Shift:=xlToRigh
    Range("K1").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-10]="""",1,RC[-10])"
    LastRow = Range("B" & Rows.Count).End(xlUp).Row
    Range("K1").AutoFill Destination:=Range("K1:K" & LastRow), Type:=xlFillCopy

    Range("K1").Select
    Range(Selection, Selection.End(xlDown)).Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

'   Reordenamiento de columnas
    Columns("K:K").Cut                      'folio
    Columns("A:A").Insert Shift:=xlToRight
    Range("B:B").Columns.Delete

'   selecciona y copia de temp "forward"
    last_row = Cells(Rows.Count, 1).End(xlUp).Row           'Get last row
    last_col = Cells(1, Columns.Count).End(xlToLeft).Column 'Get last column
    Range(Cells(1, 1), Cells(last_row, last_col)).Select    'Select entire table
    Selection.Copy                                          'copia seleccion

    Worksheets("Final_Sheet").Select
    last_row = Sheets("Final_Sheet").Cells(Rows.Count, 1).End(xlUp).Row
    Sheets("Final_Sheet").Cells(last_row + 1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False                           'pega a temporal
    Application.CutCopyMode = False
    
    Sheets("temp").Delete

End Sub

My problem is the copy&paste that is between lines 111 to119 (copies the first sheet), plus 238 to 248 that copies below the first data the values of the second sheet. This data that I'm copying goes from columns "A" to "K" in the sheet Final_Sheet, in this sheet in column "L" I have some formulas (color green in my image), the thing is that if column "M" or "N" is empty, after copying everything is alright, BUT if I put other formulas on column "M" o "N" after copying in the range that is in salmon color, all the formulas or values in "L" column are deleted. Is there any way that this doesn't happen?

Example where I paste

There are a few comments in my code but they are in Spanish, have a nice day, sorry to bother

  • 1
    Your code is quite long and the use of select/activate makes it more difficult to follow than it needs to be. FYI in 99.5% of cases where you have `someRange.Select` followed by `Selection.doSomething` you can replace those 2 lines with `someRange.doSomething` – Tim Williams Jan 29 '22 at 03:03

1 Answers1

1

I tried to replicate, and it seems your range selections are different in column size, so some of them do overlap on Final_Sheet on Columns with formulas. Difficult to advise without seeing original data you are dealing with... It may be as the raw data has some empty cells which are not empty and the code .End(xlToLeft).Column selects more than you excpected.

If raw data files are always in the same format, better specify which columns you want to copy data from without blindly selecting them using .End(xlToLeft).Column. Or go by column Header name if you have them constantly named the same.

On another hand, - such an easy task may be much more reliable and repeatable on Excel Power Query.

NoobVB
  • 989
  • 6
  • 10