Selecting Range depending on found Cell and PasteSpecial

Question

here's the code. I posted all of it so you have a better understanding of its purpose. The loop should execute for all "Contabilidad" in Column B. Then it locates the first "Contabilidad", saves the variables accordingly and then looks for FindString2, also according to the found cell, in inventario. There it does the main tasks. This all works fine in theory.

The problem is: Going back to Registro, selecting the row, where "Contabilidad" was found earlier from column A to J. After selecting the range, it should copy and paste it to another sheet, go back and delete the selected information.

For example: A2 is where we found "COntabilidad". It should select A1 to J1 and then copy/paste etc.

I very much appreciate all help and comments. Thank you very much, beste regards a true Newbie:)

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

Your question is somewhat difficult to understand, but if I am getting it right, you are trying to search for a value, then select the entire row of the cell containing that value? If that's all you are trying to do then you have way more code than you need — K.Dᴀᴠɪs, Oct 16 '17 at 23:18
Review this post: https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba If you follow the suggestions there it will make your code simpler and easier to follow. This is an error `ActiveSheet.Range("Rng3:Rng4").Select` - you probably need `ActiveSheet.Range(Rng3, Rng4).Select` but really a good re-write would be a better investment. — Tim Williams, Oct 17 '17 at 02:27

Selecting Range depending on found Cell and PasteSpecial

0 Answers0