Question

需要一些帮助才能创建excel VBA。我几乎没有经验，通常只是在网上找到VGA并进行调整。

我想复制第2行到第14行/ A列中的数据A：B，D：F（跳过C列） IF单元格F高于0.1 从sheet1到第17到30行/列A：E在表2上。（如果我不能跳过C列，我可以更改我的数据以应对此问题）

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

我想在复制之前想要跳过一个列之前创建了我自己的，我得到了一半...我只是无法弄清楚如何从某一行开始复制而不是下一行...

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＆gt;＆gt; Paste命令分为2行。

下面的代码只会粘贴值，而不会在“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().Range()返回相对于Row的范围。知道这允许用来编写一些非常干净和简洁的代码。

复制数据和格式

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行是＆＃34;标题＆＃34;行

VBA - 将指定范围内的数据复制到另一个工作表

4 个答案:

复制数据和格式

仅复制数据