Copy data from one sheet to another while changing VLookup-CodePudding

Hi I am new to excel macros and I am trying to copy data from one sheet to another. in 1st sheet I have data like below

Id  Name   Salary
1   AAA    1000
2   BBB    5000
3   CCC    6000

In another sheet2 I have a button and on click of it I need to generate the data in below format (kind of a form) for all the records from sheet1.

Id
Date   (Today's Date)
Name
Salary
--Few More Specific Data

In my case on click of the button I need above form to be filled in data from sheet1 for 3 times like,

Id    1
Date  21/OCT/2021
Name  AAA
Salary  1000

Id    2
Date  21/OCT/2021
Name  BBB
Salary  5000

Id    3
Date  21/OCT/2021
Name  CCC
Salary  6000

I used VLOOKUP and filled for 1st record and thought of copy and paste this first form data on click of the button to as many times as number of records in sheet1. But I am not sure how to use the VLOOKUP for next record when copy and pasting using VBA code.

Below is the code I have tried so for,

Dim destCell As Range
Set destCell = Worksheets("sheet2").Cells(Rows.Count, "B").End(xlUp)
If destCell.Row > 1 Then Set destCell = destCell.Offset(2)
Worksheets("sheet2").Range("B6:Q20").Copy
destCell.Worksheet.Select
destCell.Select
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormulas
destCell.Select

Application.CutCopyMode = False

I need to loop through this for those many records in sheet1 and also while pasting I have to change the Id and VLOOKUP formula.

CodePudding user response：

Please, test the next code. It will return in the next sheet. You can use whatever sheet you need, but it must be set:

Sub testSummarizeSalaries()
  Dim sh As Worksheet, Destination As Worksheet, lastRow As Long, arr, arrFin, i As Long, k As Long
  
  Set sh = ActiveSheet      'use here the sheet you need
  Set Destination = sh.Next 'use here the sheet you need
  lastRow = sh.Range("A" & sh.rows.count).End(xlUp).row 'if not the range starts with column A:A, use the appropriate column
  arr = sh.Range("A2:C" & lastRow).Value 'place the range in an array for faster iteration
                                         'if the range to be processed is not in columns A:C, use there the real columns
  ReDim arrFin(1 To UBound(arr) * 4, 1 To 2):  k = 1 'reDim the final array and initialize k
   For i = 1 To UBound(arr)
        arrFin(k, 1) = "ID": arrFin(k, 2) = arr(i, 1): k = k   1
        arrFin(k, 1) = "Date": arrFin(k, 2) = format(Date, "dd/mmm/yyy"): k = k   1
        arrFin(k, 1) = "Name": arrFin(k, 2) = arr(i, 2): k = k   1
        arrFin(k, 1) = "Salary": arrFin(k, 2) = arr(i, 3): k = k   2 '2, to add an empty row after...
  Next i
  'drop the final array result, at once:
  Destination.Range("A1").Resize(UBound(arrFin), UBound(arrFin, 2)).Value = arrFin
  MsgBox "Ready..."
End Sub

CodePudding user response：

I would access the cells directly in the destination sheet, rahter than using vlookup function.

Set wsSrc = Worksheets("sheet1")
Set wsDest = Worksheets("sheet2")
idxRowDest = 1
' Not shown how to determine the number of source rows
For idxRowSrc 2 to n
    For idxColSrc = 1 to 3
        ' Copy column header in Src to fieldName in Dest
        wsDest.Cells(idxRowDest, 1).value = wsSrc.Cells(1, idxColSrc).value
        ' Copy column value in Src to fieldValue in Dest
        wsDest.Cells(idxRowDest, 2).value = wsSrc.Cells(idxRowSrc, idxColSrc).value
        idxRowDest = idxRowDest   1

        ' Other specific data
        ' ...

    Next
Next

Probably this will be a bit slower than using range operations, but is the simpler solution I find to your problem.