Copy one column from one sheet and paste in another sheet multiple times-CodePudding

Please help me, Im trying to copy one column (example: from sheet1, D3:D, so from D3 down) and paste it in another sheet (sheet2, but n times - from A3:O).

Sub Macro4()

    Sheets("sheet1").Select
    Range("C3:c").Select
    Selection.Copy
    
    Sheets("Sheet2").Select
    Range("a1:o").Select
    ActiveSheet.Paste    
    
    
End Sub

CodePudding user response：

  Sub AG()
  Dim TargetRange As Range
  Dim CopyCount As Integer
  Dim i As Integer
  Sheets("sheet1").Activate
   Range("C3:c20").Copy 'suppose your source data is in range of c3 to c20

   CopyCount = 5  '(you can change this no according to your requirement(How many times you want to paste the data))
   Sheets("Sheet2").Activate
   Set TargetRange = Range("A3")
   For i = 1 To CopyCount
   TargetRange.PasteSpecial xlPasteValuesAndNumberFormats
   Set TargetRange = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
   Next
   Worksheets("Sheet1").Columns("c").AutoFit
   Worksheets("Sheet1").Columns("c").HorizontalAlignment = xlCenter
   Application.CutCopyMode = False
   Application.CutCopyMode = False
  End Sub

CodePudding user response：

It's easy to use PasteSpecial xlPasteAll:

Sub copy_to()
    Const SRC_CELL = "D3", DST_AREA = "A3:O3"
    
    With ThisWorkbook
        .Sheets("Sheet1").Range( _
            .Sheets("Sheet1").Range(SRC_CELL), _
            .Sheets("Sheet1").Range(SRC_CELL).End(xlDown)).Copy
        .Sheets("Sheet2").Range(DST_AREA).PasteSpecial xlPasteAll
    End With
End Sub

Rem. _ is used to break lines of code for clarity

Before

After

CodePudding user response：

Copy a Column to Multiple Columns

Option Explicit

Sub CopyColumnToMultipleColumns()
    
    ' Reference the workbook ('wb').
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Reference the source worksheet ('sws').
    Dim sws As Worksheet: Set sws = wb.Worksheets("Sheet1")
    ' Calculate the last source row ('slRow'),
    ' the row of the last non-empty cell in the column.
    Dim slRow As Long: slRow = sws.Cells(sws.Rows.Count, "D").End(xlUp).Row
    ' Reference the source range ('srg').
    Dim srg As Range: Set srg = sws.Range("D3", sws.Cells(slRow, "D"))
    
    ' Reference the destination worksheet ('dws').
    Dim dws As Worksheet: Set dws = wb.Worksheets("Sheet2")
    ' Reference the first destination row ('dfrrg').
    Dim dfrrg As Range: Set dfrrg = dws.Range("A3:O3")
    
    ' Copy.
    srg.Copy dfrrg
    
End Sub