如何将行从一个Excel工作表复制到另一个工作表,并使用VBA创建重复项? [英] How to copy rows from one excel sheet to another and create duplicates using VBA?
问题描述
我有两张工作表的excel工作簿:sheet1在A到R列中有一个大数据表,在第1行有标题.Sheet2在A到AO列中有数据.
I have excel workbook with two sheets: sheet1 has a large table of data in columns A to R, headers at row 1. Sheet2 has data in columns A to AO.
使用VBA,我正在尝试从sheet1复制行并将其粘贴到sheet2的末尾.另外,我只需要复制A到R列,而不是整个行.
Using VBA I am trying to copy rows from sheet1 and paste them to the end of sheet2. Also I need to copy only columns A to R, not the entire row.
换句话说,需要将工作表1中的单元格A2:R2复制到第一行和第二行,这些行的A列中没有数据.
In other words, cells A2:R2 from sheet1 need to be copied to first AND second row that don't have data in column A.
我们非常感谢您的帮助!
Any help is highly appreciated!
@AlistairWeir,我有一个以下代码可以从sheet1中复制所需的单元格,但是我不知道如何将每行复制两次.
@AlistairWeir, I have a following code that copies the required cells from sheet1, but I cannot figure out how to copy every row twice.
Sub example()
For Each ce In Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
If Not IsEmpty(ce) Then
Sheets("sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 18).Value = Range(ce, ce.Offset(0, 17)).Value
End If
Next ce
End Sub
推荐答案
尝试一下:
Option Explicit
Sub CopyRows()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim i As Integer, k As Integer
Dim ws1LR As Long, ws2LR As Long
Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")
ws1LR = ws1.Range("A" & Rows.Count).End(xlUp).Row + 1
ws2LR = ws2.Range("A" & Rows.Count).End(xlUp).Row + 1
i = 2
k = ws2LR
Do Until i = ws1LR
With ws1
.Range(.Cells(i, 1), .Cells(i, 18)).Copy
End With
With ws2
.Cells(k, 1).PasteSpecial
.Cells(k, 1).Offset(1, 0).PasteSpecial
End With
k = k + 2
i = i + 1
Loop
End Sub
更改Sheet1
和Sheet2
(如果它们在您的工作簿中被称为不同的事物).
Change Sheet1
and Sheet2
if they are called different things in your workbook.
这篇关于如何将行从一个Excel工作表复制到另一个工作表,并使用VBA创建重复项?的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!