基于单元格值代码的 Excel vba 复制和粘贴不起作用

debugcn 发表于 Dev

杜布兹迈斯特

所以我对 VBA 编码很陌生，我正在尝试设置一个命令按钮，当激活时，它会将所有内容从“Opties”表复制到 D 和 F 列中的“BOM”表，其中列中有 1，标题为“Totaal” ”并删除空格。

到目前为止，这是我的代码

Sub Copy()
Dim c As Integer
Dim x As Integer
Dim y As Integer
Dim ws1 As Worksheet: Set ws1 = Sheets("Optie")
Dim ws2 As Worksheet: Set ws2 = Sheets("BOM")
Dim colNum As Integer

colNum = Worksheetfuntion.Match("Totaal", ws1.Range("A1:ZZ1"), 0)
c = 1
x = -4 + colNum
y = -6 + colNum
Set rng1 = ws1.Column(colNum)
Set rng2 = ws2.Range("C5:C25000")

For Each c In ws1.rng1

rng1.Offset(0, x).Copy
rng2.Offset(0, 1).PasteSpecial xlPasteValues
rng1.Offset(0, y).Copy
rng2.Offset(0, 2).PasteSpecial xlPasteValues


Next c
End Sub

YoE3K

我认为以下代码应该有效：

'Try to avoid using names that Excel uses - you will sometimes "block" the
'native function, so call the subroutine "myCopy" or something else, but
'preferably not "Copy"
Sub myCopy()
    Dim r1 As Long ' Use Long rather than Integer, because Excel
    Dim r2 As Long ' now allows for more than 65536 rows
    'Use Worksheets collection for worksheets, and only use the Sheets
    ' collection if you need to process Charts as well as Worksheets
    Dim ws1 As Worksheet: Set ws1 = Worksheets("Optie") 'Should this be "Opties"?
    Dim ws2 As Worksheet: Set ws2 = Worksheets("BOM")
    Dim colNum As Long

    colNum = WorksheetFunction.Match("Totaal", ws1.Range("A1:ZZ1"), 0)
    r2 = 5 ' I guessed that 5 is the first row you want to write to

    'Loop through every row until the last non-empty row in Totaal column
    For r1 = 1 To ws1.Cells(ws1.Rows.Count, colNum).End(xlUp).Row
        'See if value in Totaal column is 1
        If ws1.Cells(r1, colNum).Value = 1 Then
            'I have guessed that your destination columns are D & E based on 
            'your Offset(0, 1) and Offset(0, 2) from column C
            'I have guessed that your source columns are F & D based on the
            'question mentioning those columns, and the offsets of -4 and -6
            'in your current code - I assume based on "Totaal" being column J
            'Change my guesses as necessary

            'Copy values to destination from source
            ws2.Cells(r2, "D").Value = ws1.Cells(r1, "F").Value
            ws2.Cells(r2, "E").Value = ws1.Cells(r1, "D").Value
            'Increment row counter for destination sheet
            r2 = r2 + 1
        End If
    Next
End Sub

本文收集自互联网，转载请注明来源。

如有侵权，请联系[email protected] 删除。