Argthtjtr

I have to create a macro in VBA. I'm really a newcomer in this, and I don't know really how to do it, but I have basic programming skills. I have to copy the salary of the people that go from column D to an indefinite number (because they can add later more people to the list).
If in column B finds numbers it has to copy the salary, code and name of the column corresponding to people until the end in the other sheet:

It have to do something like this:

This is my code:

Sub CopiarCeldas()



Dim i As Long, UltimaFila As Long, UltimaColumna As Long



Set Uno = Sheets("1")

Set Datos = Sheets("Datos")



lastRow = Uno.Cells(Rows.Count, "G").End(xlUp).Row



For i = 5 To lastRow

    'test if cell is empty

    If Uno.Range("B" & i).Value <> "" Then

        Datos.Range("D" & i - 1).Value = Uno.Range("G" & i).Value

        Datos.Range("L" & i - 1).Value = Uno.Range("L" & i).Value

    End If

Next i

      End sub

You could try something like this.

You populate the array with the item numbers and the sheets name.

Sub CompareCopy()

Dim FirstSheet As Worksheet

Set FirstSheet = ActiveWorkbook.Worksheets("Sheet1") 'Define data sheet

Dim SecondSheet As Worksheet

Set SecondSheet = ActiveWorkbook.Worksheets("Sheet2") 'Define sheet to paste into

Dim lcol As Long

Dim lrow As Long

Dim lrowCompare As Long

Dim Val As String

Dim i As Long

Dim j As Long

Dim arr() 'Define the array



arr() = Array(1, 12, 13, 32, 42, 48, 162, 178, 216, 316, 321, 789, 987, 995, 996, 997, 999) 'Set the array with all the item numbers you want to compare



lcol = FirstSheet.Cells(5, Columns.Count).End(xlToLeft).Column 'Find last column in Row 5

lrow = FirstSheet.Cells(Rows.Count, 2).End(xlUp).Row 'Find last row in Sheet1, for column B

lrowCompare = SecondSheet.Cells(Rows.Count, 2).End(xlUp).Row 'Find last row in Sheet2 for Column B



For k = 4 To lcol                                'Loop from Column D to last Column

    For i = 11 To lrow                           'Loop through ID column in Sheet 1

        Val = FirstSheet.Cells(i, 2).Value       'Get Item Value in Sheet 1

        For Each arrayItem In arr                'Loop through each element in Array

            If arrayItem = Val Then              'If array item is equal to Val then

                SecondSheet.Cells(lrowCompare, 3).Value = arrayItem 'Print array item

                SecondSheet.Cells(lrowCompare, 1).Value = FirstSheet.Cells(5, k).Value 'Print number

                SecondSheet.Cells(lrowCompare, 2).Value = FirstSheet.Cells(6, k).Value 'Print name

                If FirstSheet.Cells(i, k).Value <> "" Then 'If cell value is blank then ignore otherwise copy value

                    SecondSheet.Cells(lrowCompare, 4).Value = FirstSheet.Cells(i, k).Value 'Copy value

                End If

                lrowCompare = lrowCompare + 1    'Add 1 to row

            End If

        Next arrayItem

    Next i

Next k

End Sub

Assuming that the data sheet is named Sheet1 and the result sheet is named Sheet2, you can try:

Sub test()



    Dim n As Integer 'n will represent the column at which you find the first people

    n = 4

    Dim m As Integer 'm will represent the row on your Sheet2

    m = 2



    Worksheets("Sheet1").Activate



    ' Loop on the people's name

    Do While Not IsEmpty(Cells(6, n))

        ' Loop on items, 50 to be replaced by the row number of your last item

        For i = 11 To 50

            If Not IsEmpty(Cells(i, 2)) Then

                ' Report people main salary

                Sheets("Sheet1").Activate

                Cells(5, n).Select

                Selection.Copy

                Sheets("Sheet2").Select

                Cells(m, 2).Select

                ActiveSheet.Paste

                'Report people name

                Sheets("Sheet1").Activate

                Cells(6, n).Select

                Selection.Copy

                Sheets("Sheet2").Select

                Cells(m, 3).Select

                ActiveSheet.Paste

                ' Report item code

                Sheets("Sheet1").Activate

                Cells(i, 2).Select

                Selection.Copy

                Sheets("Sheet2").Select

                Cells(m, 4).Select

                ActiveSheet.Paste

                'Report item value

                Sheets("Sheet1").Activate

                Cells(i, n).Select

                Selection.Copy

                Sheets("Sheet2").Select

                Cells(m, 5).Select

                ActiveSheet.Paste

                m = m + 1 'Iterate row counter

            End If

        Worksheets("Sheet1").Activate

        ' Next item for the same people

        Next i

    ' Next people

    n = n + 1

    Loop

    Worksheets("Sheet2").Activate

End Sub