Question

这是代码。我发布了所有内容，以便您更好地了解其目的。循环应该对B列中的所有“Contabilidad”执行。然后它找到第一个“Contabilidad”，相应地保存变量，然后根据找到的单元格在inventario中查找FindString2。它完成了主要任务。这一切在理论上都很好。

问题是：回到Registro，选择行，其中从A列到J之前找到“Contabilidad”。选择范围后，应将其复制并粘贴到另一张纸上，返回并删除所选信息。

例如：A2是我们找到“COntabilidad”的地方。它应该选择A1到J1，然后复制/粘贴等。

我非常感谢所有的帮助和评论。非常感谢你，至少是一个真正的新手:)

Private Sub ConfirmarEntrada_Click()
Dim nument As Integer  
Dim numpre As Integer  
Dim numval As Integer  
Dim FindString1 As String  
Dim FindString2 As String  
Dim Rng1 As Range  
Dim Rng2 As Range  
Dim Rng3 As Range  
Dim Rng4 As Range  
Dim kopieren As Range  
Dim counter As Integer  
counter = Application.WorksheetFunction.CountIf(Range("B:B"), "Contabilidad")  
Do While counter > 0  
FindString1 = "Contabilidad"  
With Worksheets("Registro").Range("B:B")  
    Set Rng1 = .Find(What:=FindString1,
                        After:=.Cells(.Cells.count), _  
                        LookIn:=xlValues, _  
                        LookAt:=xlWhole, _  
                        SearchOrder:=xlByRows, _  
                        SearchDirection:=xlNext, _  
                        MatchCase:=False)  
    End With  
    If Not Rng1 Is Nothing Then  
        Application.Goto Rng1.Offset(0, 1), True  
        FindString2 = ActiveCell.Value  
        ActiveCell.Offset(0, 1).Select  
        numpre = ActiveCell.Value  
        ActiveCell.Offset(0, 1).Select  
        nument = ActiveCell.Value  
        ActiveCell.Offset(0, 1).Select  
        numval = ActiveCell.Value  
        If IsNumeric(numpre) And IsNumeric(nument) And IsNumeric(numval) And FindString2 <> vbNullString Then  
            With Worksheets("Inventario").Range("B4:B400")  
                Set Rng2 = .Find(What:=FindString2, _  
                                After:=.Cells(.Cells.count), _  
                                LookIn:=xlValues, _  
                                LookAt:=xlWhole, _  
                                SearchOrder:=xlByRows, _  
                                SearchDirection:=xlNext, _  
                                MatchCase:=False)  
            End With  
            If Not Rng2 Is Nothing Then  
                Application.Goto Rng2.Offset(0, 3), True  
                ActiveCell.Value = ActiveCell.Value + numpre  
                ActiveCell.Offset(0, 1).Select  
                ActiveCell.Value = ActiveCell.Value + nument  
                ActiveCell.Offset(0, 3).Select  
                ActiveCell.Value = ActiveCell.Value + numval  
                Sheets("Registro").Select  
                Rng3 = Worksheets("Registro").Range(Rng1).Offset(0, -1)  
                Rng4 = Rng1.Offset(0, 8)  
                ActiveSheet.Range("Rng3:Rng4").Select  
                Selection.Copy  
                Sheets("Detaille Completo").Select  
                NextFree = ActiveSheet.Range("C8:C" &   Rows.count).Cells.SpecialCells(xlCellTypeBlanks).Row  
                ActiveSheet.Range("A" & NextFree).PasteSpecial xlPasteValues  
                Sheets("Registro").Select  
                ActiveSheet.Range("Rng1").Offset(RowOffSet:=0,   ColumnOffset:=9).Select  
                Selection.SpecialCells(xlCellTypeConstants, 3).Select  
                Selection.ClearContents  
                Sheets("Registro").Select  
                ActiveWindow.ScrollRow = 1  
                ActiveWindow.ScrollColumn = 1  
                MsgBox "Exitóso."  
            Else  
                MsgBox "Producto no existe o Codigo está mala."  
            End If  
        Else  
            MsgBox "Producto no existe o Codigo está mala."  
        End If  
    End If  
counter = counter - 1  
Loop  
End Sub

根据找到的Cell和PasteSpecial

0 个答案: