從一張紙上復制一列並多次粘貼到另一張紙上

Question

請幫助我，我試圖復制一列（例如：從 sheet1，D3:D，所以從 D3 向下）並將其粘貼到另一張表中（sheet2，但 n 次 - 從 A3:O）。

Sub Macro4()

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

Answer 1

  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

Answer 2

使用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

雷姆。 _用於為了清楚起見而中斷代碼行

前

后

Answer 3

將一列復制到多列

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