Question

我很难问这个愚蠢的问题，但我无法根据H表1中的值将一些数据从Sheet 1中的多行复制到Sheet 2。

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

在Sheet2中从第7行开始

A栏=日期

B栏= B栏（Sheet1）

C列= C列（Sheet1）

D列= D列（Sheet1）

E列= E列（Sheet1）

列F = Colunb 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中的某些行复制特定单元格，具体取决于列中的非零值到工作表2的最后一个空行

1 个答案: