CODEWITHSUNDEEP
excelvba
Newbie
Newbie

Reputation: 81

VBA - Copy and Paste Multiple Times Between Excel Sheets

I have a set of x names (in row 4) with corresponding dates (row 3) (the combination of name and date is unique).

I would like to copy the unique name and date, and then paste it x times (where x is the total number of names) in a different sheet.

I would like the code to loop through all names and dates and paste them within column A,B in a new sheet. Where column A has heading name and column B has heading date.

Initial data:

Initial data

After Code:

After Code

What I have attempted so far - i can't seem to get the paste correct

Sub Test()
    
    Dim o           As Variant
    Dim CountC_Range As Range
    Dim cel_3       As Range
    Dim MyRange     As Range
    
    'count the number of different engagement areas
    Worksheets("Sheet8").Activate
    Range("B4").Select
    Set CountC_Range = Range("B4", Selection.End(xlToRight))
    
    'Set the letter k as number of engagements as we'll use this later
    o = WorksheetFunction.CountA(CountC_Range) - "1"
    
    Worksheets("sheet9").Activate
    Range("A1").Select
    MyRange = Range("Selection.End(xlDown) + 1", "Selection.End(xlDown) + o + 1")
    
    For Each cel_3 In Worksheets("Sheet8").Range("4:4")
        If cel_3.Value <> "" Then                
            MyRange = cel_3.Value                
        End If            
    Next cel_3
    
End Sub

Upvotes: 0

Views: 710

Answers (1)

Vityata
Vityata

Reputation: 43585

There are plenty of ways to do it, but having this input:

enter image description here

The code below will provide this:

enter image description here

Sub TestMe()
            
    With Worksheets("Source")
        Dim k As Long
        k = .Range("A4").End(xlToRight).Column
    End With
    
    With Worksheets("Target")
        Dim i As Long, ii As Long
        Dim currentRow As Long
        
        For i = 1 To k
            For ii = 1 To k
                currentRow = currentRow + 1
                .Cells(currentRow, "A") = Worksheets("Source").Cells(3, i)
                .Cells(currentRow, "B") = Worksheets("Source").Cells(4, i)
            Next
        Next
    End With
  
End Sub

Dependencies:

  • Name the input worksheet "Source"
  • Name the output worksheet "Target"

A must read - How to avoid using Select in Excel VBA

Upvotes: 1

Related Questions