VBA – 将指定范围内的数据复制到另一个表单上的另一个指定范围

需要一些帮助创build一个Excel VBA。 我几乎没有经验，通常只是在网上findVBAs和调整。

我想从第2行到第14行的A行复制数据A：B，D：F（跳过列C） 如果单元格F从sheet1到行17到30 /列A：E 大于0.1 。我不能跳过列CI可以改变我的数据来应付这个）

我也将在sheet2中有一定的格式不会在sheet1上，所以我需要确保数据只被复制为一个值。

我试图创build自己的之前，我想跳过一列，复制时，我有一半..我只是无法弄清楚如何复制从某一行开始，而不是下一个可用…

Private Sub Workbook_Open() Dim i For i = 2 To 14 If Sheets("sheet1").Cells(i, "f").Value > 0.1 Then Sheets("sheet1").Cells(i, "f").EntireRow.Copy Destination:=Sheets("sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1) End If Next i End Sub 

Answer 1

不知道为什么要在Workbook_Open事件中使用此代码，但由于您只需要粘贴值（而不是格式），因此需要将“ Copy >> Paste命令分成两行。

下面的代码将只粘贴值，而不会在“sheet2”中的列C中留下空白：

 Private Sub Workbook_Open() Dim i As Long With Sheets("sheet1") For i = 2 To 14 If .Cells(i, "F").Value > 0.1 Then .Range("A" & i & ":B" & i & "," & "D" & i & ":F" & i).Copy Sheets("sheet2").Range("A" & i + 15).PasteSpecial Paste:=xlPasteValues, _ Operation:=xlNone, SkipBlanks:=False End If Next i End With End Sub 

编辑1 ：如果您不希望在“Sheet2”中有空行（在单元格F <= 0.1的情况下），则使用下面的代码，它将从第15行开始粘贴连续行的值：

 Dim i As Long Dim j As Long ' start row number in Sheet2 (for pasted rows) j = 15 With Sheets("sheet1") For i = 2 To 14 If .Cells(i, "F").Value > 0.1 Then .Range("A" & i & ":B" & i & "," & "D" & i & ":F" & i).Copy Sheets("sheet2").Range("A" & j).PasteSpecial Paste:=xlPasteValues, _ Operation:=xlNone, SkipBlanks:=False j = j + 1 End If Next i End With 

Answer 2

我想这是你要求的。 它将粘贴细胞到i + 15（所以细胞2贴到17，细胞14到29）。 我也将它分成两个独立的复制函数，以便您可以跳过列c。

 Private Sub Workbook_Open() Dim i For i = 2 To 14 If Sheets("sheet1").Cells(i, "f").Value > 0.1 Then Sheets("sheet1").Range("A" & i & ":B" & i).Copy Destination:=Sheets("sheet2").Range("A" & i + 15) Sheets("sheet1").Range("D" & i & ":F" & i).Copy Destination:=Sheets("sheet2").Range("D" & i + 15) End If Next i End Sub 

Answer 3

Rows返回Rows中所有单元格的范围对象。 Rows().Range()返回一个相对于行的范围。 知道这允许使用写一些非常干净和浓缩的代码。

---

复制数据和格式

 Private Sub Workbook_Open() Dim i As Long Dim Target As Range Set Target = Sheets("sheet2").Range("A17") With Sheets("sheet1") For i = 2 To 14 If .Cells(i, "f").Value > 0.1 Then .Rows(i).Range("A1:B1,D1:F1").Copy Destination:=Target.Offset(i - 2) End If Next i End With End Sub 

仅复制数据

 Private Sub Workbook_Open1() Dim i As Long Dim Target As Range Set Target = Sheets("sheet2").Range("A17") With Sheets("sheet1") For i = 2 To 14 If .Cells(i, "f").Value > 0.1 Then .Rows(i).Range("A1:B1,D1:F1").Copy Target.Offset(i - 2).PasteSpecial xlPasteValues End If Next i End With Application.CutCopyMode = False End Sub 

Answer 4

您可以利用Range对象的AutoFilter()和SpecialCells()方法，如下面的（注释）代码所示：

 With Worksheets("sheet1").Range("A1:F14") '<--| reference your relevant range (including headers in row 1) .AutoFilter Field:=6, Criteria1:=">0.1" '<--| filter data on column "F" (the 6th of your referenced range) with values greater than 0.1 If Application.WorksheetFunction.Subtotal(103, .Cells.Resize(, 1)) > 1 Then '<--| if any cell other than header ones has been filtered... .Columns(3).Hidden = True ' <--| temporarily hide column "C" (the 3rd of your referenced range) not to be "caught" by subsequent filter on visible cells .Offset(1).Resize(.Rows.count - 1).SpecialCells(xlCellTypeVisible).Copy '<--| copy "visible" cells (skipping headers) Worksheets("sheet2").Range("A1").PasteSpecial xlPasteValues '<--| paste values .Columns(3).Hidden = False '<--| bring column "C" back visible End If End With 

假设工作表sheet1第1行是“标题”行