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:
Ik ben nieuw met VBA, vandaar zullen er misschien fouten in zitten die ik nog niet zie.
any help would be appreciated
Sheet1
Bestelnr Omschrijving Prijs Bruto Prijs Netto Artikelcode
Sheet 2
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: