[vba Excel 2010] cellen in rij updaten vanuit andere sheet

Status
Niet open voor verdere reacties.

cschot

Gebruiker
Lid geworden
7 feb 2006
Berichten
51
Ik heb een vraagje over VBA in Excel.

Sheet1

A B C D E
Bestelnr Omschrijving Prijs Bruto Prijs Netto Artikelcode


Sheet 2

A B C D E
Artikelcode Bestelnr Prijs Netto Prijs Bruto Omschrijving


Nu moeten de gegevens uit Sheet 1 geupdatet worden met de gegevens uit sheet 2.
Er moet gezocht worden op Artikelcode, en in die rij moeten de andere cellen geupdatet worden.
Artikelcode is in beide sheets hetzelfde. Maar de producten staan tussen andere producten in sheet 2

Ik heb deze scripts al geprobeerd, maar sommige werken niet helemaal, en anderen
doen niet wat ik wil:

Code:
    Sub SearchForString()

        Dim LSearchRow As Integer
        Dim LCopyToRow As Integer

        'On Error GoTo Err_Execute

        'Start search in row 4
        LSearchRow = 4

        'Start copying data to row 2 in Sheet2 (row counter variable)
        LCopyToRow = 2

       'While Sheets(1).Range("AQ1").Value = Sheets(2).Range("A" & CStr(LSearchRow)).Value Then

                'Select row in Sheet1 to copy
                Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
                Selection.Copy

                'Paste row into Sheet2 in next row
                Sheets(5).Select
                Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
                ActiveSheet.Paste

                'Move counter to next row
                LCopyToRow = LCopyToRow + 1

                'Go back to Sheet1 to continue searching
               ' Sheets("Sheet1").Select


                ActiveCell.Offset(1, 0).Select

        'Wend

        'Position on cell A3
        Application.CutCopyMode = False
        Range("A3").Select

        MsgBox "All matching data has been copied."

        Exit Sub

Err_Execute:
        MsgBox "An error occurred."

    End Sub
Code:
    Public Sub MoveData()

Dim ArtNrs As Range
Dim items As Worksheet
Dim prijslijst As Worksheet
Dim spRange As Range
Dim cell As Range
Dim cell1 As Range


Set prijslijst = Sheets("prijslijst")
Set ArtNrs = prijslijst.Range("A5")
Set ArtNrs = prijslijst.Range("A5" & ArtNrs.End(xlDown).Address)
Set items = Sheets("items")
Set spRange = items.Range("AQ1")
Set spRange = items.Range("AQ1:" & spRange.End(xlDown).Address)
For Each cell In spRange
    If cell.Value = ArtNr Then
        copyRowTo prijslijst.Range(cell.Row & ":" & cell.Row), items
    End If
Next cell

End Sub

Sub copyRowTo(rng As Range, ws As Worksheet)
    Dim newRange As Range
    Set newRange = ws.Range("A926")

        Set newRange = rng
    
    rng.Copy
    newRange.PasteSpecial (xlPasteAll)
End Sub
Code:
Sub CopySignificant()
  'Copy cells of cols A,F,E,D from rows containing "Significant" in
  'col D of the active worksheet (source sheet) to cols
  'A,B,C,D of Sheet2 (destination sheet)
  Dim DestSheet        As Worksheet
  Set DestSheet = Worksheets("Blad4")
  
  Dim sRow       As Long     'row index on source worksheet
  Dim dRow       As Long     'row index on destination worksheet
  Dim sCount     As Long
  sCount = 0
  dRow = 1
  sRow = 1

  For sRow = 1 To Range("AQ1000").End(xlUp).Row
     'use pattern matching to find "Significant" anywhere in cell
     If Cells(sRow, "AQ") Like Cells(dRow, "A") Then
        sCount = sCount + 1
        dRow = dRow + 1
        'copy cols A,F,E & D
        Cells(sRow, "A").Copy Destination:=DestSheet.Cells(dRow, "A")
        Cells(sRow, "F").Copy Destination:=DestSheet.Cells(dRow, "B")
        Cells(sRow, "E").Copy Destination:=DestSheet.Cells(dRow, "C")
        Cells(sRow, "D").Copy Destination:=DestSheet.Cells(dRow, "D")
     End If
  Next sRow
  
  MsgBox sCount & " rows copied", vbInformation, "Transfer Done"

End Sub

Ik ben nieuw met VBA, vandaar zullen er misschien fouten in zitten die ik nog niet zie.

any help would be appreciated
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan