Fout in macro

[rg027]

ik heb volgende macro

Sub zetover()

 For Each b In Sheets("blad2").Range("a1", Range("a65536").End(xlUp))
 If b = Sheets("blad1").Range("a1") Then
 b.Select
 
  Sheets("blad1").Range("A3:A8").Select
    Selection.Copy
    Sheets("Blad2").Select
    b.Offset(0, 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("A1").Select
    Else
    Sheets("blad1").Select
     Sheets("blad1").Range("A3:A8").Select
    Selection.Copy
     Sheets("Blad2").Select
   Range("a65536").End(xlUp).Offset(1).Select
   ActiveCell = Sheets("blad1").Range("a1")
   ActiveCell.Offset(0, 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("A1").Select
End If
Exit Sub
Next

End Sub

de bedoeling van deze macro is : als de waarde van cel a1 van blad 1 voorkomt in kolom a van blad 2 dat ie de waarde overschrijft en indien deze niet voorkomt dat ie een nieuwe regel aanvult in blad 2. doch deze doet het niet. Iemand die me kan wijzen waar de fout ziet? Alvast dank

 

[Wigi]

als de waarde van cel a1 van blad 1 voorkomt in kolom a van blad 2 dat ie de waarde overschrijft

Dus je gaat iets opzoeken, en als je het gevonden hebt ga je het overschrijven met ... hetzelfde? Want daarop heb je toch gezocht

Vermijd het gebruik van .Select aub, dat is niet nodig.

Ook moet je lussen zien te vermijden. Gebruik bvb. Find.

 

[rg027]

De gegevens die bij een bepaald nr behoren kunnen veranderen. daarom het overschrijven

 

[Wigi]

Zoiets dan, ongetest:

Sub opzoeken()
    
    Dim r As Range
    
    On Error Resume Next
    Set r = Range("A1", Range("A" & Rows.Count).End(xlUp)).Find(what:=Sheets("blad1").Range("A1").Value, LookIn:=xlValues, lookat:=xlWhole)
    
    Sheets("blad1").Range("A3:A8").Copy
    
    If Not r Is Nothing Then
        r.Offset(, 1).PasteSpecial xlValues, Transpose:=True
    Else
        With Range("A" & Rows.Count).End(xlUp).Offset(1)
            .Offset(, 1).PasteSpecial xlValues, Transpose:=True
            .Value = Sheets("blad1").Range("A1").Value
        End With
    End If

End Sub

Wigi

 

[snb]

Deze oneliner doet hetzelfde als jouw macro:

Sub och()
 on error resume next
 Sheets("blad2").columns(1).find([blad1!a1]),,xlvalues,xlwhole).offset(,1).resize(5)=  [blad1!A3:A8].value
Enn Sub

 

[rg027]

Wigi bedankt voor deze vlugge reaktie. ik heb hem uitgetest en ie doet wat ik wil. Ik ga de code eens bestuderen zodat ik snap wat er gebeurd. Nogmaals hartelijke dank

 

[Wigi]

Deze oneliner doet hetzelfde als jouw macro:

Sub och()
 on error resume next
 Sheets("blad2").columns(1).find([blad1!a1]),,xlvalues,xlwhole).offset(,1).resize(5)=  [blad1!A3:A8].value
Enn Sub

En die nieuwe regel aanvullen dan?

A3:A8 zijn 6 cellen :thumb:

Ik wilde niet zo'n korte code schrijven aangezien het contrast / de stap met de eerdere code dan redelijk groot zou zijn. Vandaar mijn langere versie.

 

[rg027]

Toch nog een bijkomnde vraag. Kan het ook in omgekeerde richting werken? Als ik in blad 1cel a1 een waarde intyp dat ie de gegevens gaat zoeken in blad 2 en deze terug zet ? De bedoeling is om makkelijk iets terug te vinden uit een steeds groeiend aantal gegegens

 

[snb]

@Wigi

Zo ?

Sub och()
 on error resume next
 Sheets("blad2").columns(1).find([blad1!a1]),,xlvalues,xlwhole).offset(,1).resize(6)=  worksheetfunction.transpose([blad1!A3:A8])
  if err.number>0 then Sheets("blad2").cells(rows.count,1).offset(1).resize(7)=split([blad1[COLOR="Red"][B]![/B][/COLOR]A1] & "|" & join(worksheetfunction.transpose([blad1!A3:A8]),"|"),"|")
End Sub

 

[rg027]

neen deze doet het niet.

 

[snb]

laatste suggestie verbeterd (typefout)

 

[rg027]

er staat blijkbaar nog een fout. Ik krijg de foutmelding
compileerfout
verwacht instuctie einde

 

[Warme bakkertje]

Er stond nog een haakje teveel

Sub och()
 On Error Resume Next
 Sheets("blad2").Columns(1).Find([blad1!a1], , xlValues, xlWhole).Offset(, 1).Resize(6) = WorksheetFunction.Transpose([blad1!A3:A8])
  If Err.Number > 0 Then Sheets("blad2").Cells(Rows.Count, 1).Offset(1).Resize(7) = Split([blad1!a1] & "|" & Join(WorksheetFunction.Transpose([blad1!A3:A8]), "|"), "|")
End Sub

 

[rg027]

die macro doe niet wat ik wil .Wel geen foutmelding meer

 

[Wigi]

die macro doe niet wat ik wil .Wel geen foutmelding meer

Fijn.

En denk je dan niet even: laat ik omschrijven wat er gebeurt met die code en wat er eigenlijk zou moeten gebeuren...?

 

[rg027]

Idd sorry ff niet opgelet.
De macro zet op blad 2 in kolom b enkel het nr. en dat is dus niet wat ik zou willen. De bedoeling is dat ie de gegevens van een bepaald nr terug zet in blad 1 in de cellen a3:a8 . Dit om makkelijk de gevens op te vragen die bij een bepaald nr horen. Ik zou het bv met de formule vert.zoeken kunnen doen maar om bij te leren liever via vba.

 

[Hoornvan]

rg027,

Als ik het goed lees moet je dus eigenlijk een macro hebben die zoekt naar een nummer.
Het zal volgens mij duidelijker zijn met een voorbeeld, met daarin wat de bedoeling is.

De code van je doet het nu wel, maar dit zoek je niet.

Sub zetover()

 For Each b In [Blad2!A65536].End(xlUp)
 If b = [Blad1!A1] Then
   b.Select
 
    [Blad1!A3:A8].Copy
    [Blad2!].b.Offset(0, 1).PasteSpecial Paste:=xlPasteValues
    
  Else
    [Blad1!A3:A8].Copy
     Sheets("Blad2").Select
    [A65536].End(xlUp).Offset(1).Select
     ActiveCell.Offset(0, 1).PasteSpecial Paste:=xlPasteValues
    Range("A1").Select
  End If
Exit Sub
Next

End Sub

 

[Warme bakkertje]

Sub och()
 On Error Resume Next
 Sheets("blad2").Columns(1).Find([blad1!a1], , xlValues, xlWhole).Offset(, 1).Resize(, 6) = WorksheetFunction.Transpose([blad1!A3:A8])
  If Err.Number > 0 Then Sheets("blad2").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 7) = Split([blad1!a1] & "|" & Join(WorksheetFunction.Transpose([blad1!A3:A8]), "|"), "|")
End Sub

 

[rg027]

Hierbij het voorbeeldbestand.
Met de code van Wigi worden de gegevens van blad 1 aangevuld/overschreven naar blad 2.
Nu zou ik een code willen die de gegevens die bij cel a1 (blad1) horen gaat opzoeken in blad 2 en deze zet in blad 1 in het bereik "a3:a33"

vb Ik typ in cel a1 van blad 1 een nr in en de overeenkostige gegevens van blad 2 worden in blad a1 gezet waarbij kolom a van blad 2 te te zoeken nrs staan.

 

[Warme bakkertje]

Sub verzetten()
    On Error Resume Next
    [Blad1!A3:A33].ClearContents
    [Blad1!A3].Resize(31) = WorksheetFunction.Transpose(Sheets("blad2").Columns(1).Find([blad1!A1], , xlValues, xlWhole).Offset(, 1).Resize(, 31).Value)
End Sub