根据列中的非零值，将某些行中的特定单元格从 Sheet 1 复制到 Sheet 2 的最后一个空行

Question

我觉得问这个愚蠢的问题很不好，但我无法根据列 H [=39] 中的值将 Sheet 1 中多行的一些数据复制到 Sheet 2 =] 1.

如果在 H 列 (Sheet1) 中输入任何整数（正数或负数）

在Sheet2中从第7行开始

A 列 = 日期

B 列 = B 列 (Sheet1)

C 列 = c 列 (Sheet1)

D 列 = D 列 (Sheet1)

E 列 = E 列 (Sheet1)

F 列 = F 列 (Sheet1)

G 列 = H 列 (Sheet1)

这是我的代码：

 Private Sub Transfer_Click()
 Application.ScreenUpdating = False

 j = 0 'set j = # of units to transfer
 Do While Counter < 8    ' Inner loop.
 Counter = Counter + 1    ' Increment Counter.
 If Cells(10, Counter).Value = "# of units to transfer" Then
    j = Counter
 End If
 Loop

 If j <> 0 Then

 For i = 11 To 1500
               If Cells(i, j).Value = 0 Then
                Next i
               ElseIf Cells(i, j).Value <> 0 Then  
                    If OptionButton1 = True Then
                    Sheet2.Select
                    Sheet2.Range("A1").Select
                        If Sheet2.Range("A1").Offset(1, 0) <> "" Then
                        Sheet2.Range("A1").End(xlDown).Select
                        End If
                    End If
                End If

            ActiveCell.Offset(6, 0).Select 'Date column A
            ActiveCell.Value = Date
            ActiveCell.Offset(0, 1).Select 'copy Code
            ActiveCell.Value = Sheet1.Cells(i, 2).Value
            ActiveCell.Offset(0, 1).Select 'Copy Bar Code
            ActiveCell.Value = Sheet1.Cells(i, 3).Value
            ActiveCell.Offset(0, 1).Select 'Copy articul
            ActiveCell.Value = Sheet1.Cells(i, 4).Value
            ActiveCell.Offset(0, 1).Select 'Copy product name
            ActiveCell.Value = Sheet1.Cells(i, 5).Value
            ActiveCell.Offset(0, 1).Select 'Copy product unit
            ActiveCell.Value = Sheet1.Cells(i, 6).Value
            ActiveCell.Offset(0, 1).Select 'copy products on hands
            ActiveCell.Value = Sheet1.Cells(i, 8).Value
    Next i

 End If

 Application.ScreenUpdating = True
 End Sub

我觉得我做的是完全错误的，因为我不知道怎么做，但是这段代码编辑了 WorkSheet1 中的第 8 列和第 7 列（随机添加日期 xD）。在 Sheet2 中，它会造成混乱（复制 H 行中没有任何整数的额外数据，将其从最后插入的单元格向下偏移 6）=/

这个问题可能很愚蠢，但我今天花了很多时间试图解决它，并意识到我无法独自解决。非常感谢您的帮助。 =)

Answer 1

像这样：

Private Sub Transfer_Click()

     Dim j As Long, i As Long, f As Range, c As Range
     Dim sht As Worksheet

     'look for the header on row 10
     Set f = Sheet1.Rows(10).Find("# of units to transfer", lookat:=xlWhole)

     If f Is Nothing Then
        MsgBox "Header not found!", vbExclamation
    Else
        'copy to which sheet?
        If Me.OptionButton1 Then
            Set sht = Sheet2
        ElseIf Me.OptionButton2 Then
            Set sht = Sheet3
        End If

        'find the first empty row
        Set c = sht.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)

        Application.ScreenUpdating = False

        j = f.Column

        For i = 11 To 1500

            If Sheet1.Cells(i, j) <> 0 Then
                'transfer the data
                c.Value = Date
                c.Offset(0, 1).Resize(1, 5).Value = _
                                 Sheet1.Cells(i, 2).Resize(1, 5).Value
                c.Offset(0, 6).Value = Sheet1.Cells(i, 8).Value
                Set c = c.Offset(1, 0) 'next row
            End If

        Next i

        Application.ScreenUpdating = True

     End If 'found header

End Sub

根据列中的非零值，将某些行中的特定单元格从 Sheet 1 复制到 Sheet 2 的最后一个空行

Copy specific cells from sertain rows from Sheet 1 depending on non-zero value in column to the last empty row of Sheet 2

vba

excel

spreadsheet

copy-paste