Data kopiëren met VBA

Roy 1977 · 18 jul 2013

Hallo,

hoop dat iemand kan helpen

* In blad 1 kolom A plaats ik gegevens (soms vul ik 1 cel, soms 200 en alles er tussenin)
* deze gegevens wil ik met VBA kopiëren en plakken als waarden in blad 2 kolom A

Echter: in blad 2 vul ik of kolom A (met de macro) of kolom B (handmatig). Dus of kolom A is gevuld, of kolom B. De data die de macro uit blad 1 kopiëert wil ik dus geplakt hebben in kolom A van blad 2 in de eerst vrije cel op basis van wat er is ingevuld in kolom A en B.

In dit voorbeeld zou de data door de macro dus geplakt moeten worden in A64 van blad 2.

Bij voorbaat dank!
RoyBekijk bijlage Map2.xlsx

r3000 · 19 jul 2013

komt eraan!

spaarie · 19 jul 2013

Niet zo snel r3000

Code:

Sub Spaarie()
    lrow_a = Sheets(2).Range("A" & Rows.Count).End(xlUp).Row
    lrow_b = Sheets(2).Range("B" & Rows.Count).End(xlUp).Row
    If lrow_a > lrow_b Then Sheets(1).Columns(1).SpecialCells(2).Copy Sheets(2).Range("A" & Sheets(2).Range("A" & Rows.Count).End(xlUp).Row).Offset(1)
    If lrow_b > lrow_a Then Sheets(1).Columns(1).SpecialCells(2).Copy Sheets(2).Range("A" & Sheets(2).Range("B" & Rows.Count).End(xlUp).Row).Offset(1)
End Sub

r3000 · 19 jul 2013

Je bent met te snel af spaarie!

Je code is wat minder lang dan die van mij Bekijk bijlage Map2, aangepast r3000.xls

Ben dan wel geen Mega Senior, maar hij werkt wel!

Code:

Sub Invoeren()

Dim iCell As Long
Dim ws As Worksheet
Dim ws2 As Worksheet

Set ws = Worksheets("Blad1")


Sheets("Blad1").Select 'Selecteer Blad1
Columns("A:A").Select 'Selecteer kolom A
Selection.SpecialCells(xlCellTypeConstants, 23).Select 'Selecteer alle waarde in deze kolom
Selection.Copy 'kopieer de waarden

Sheets("Blad2").Select 'Selecteer Blad2
'iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
    SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1


Set ws2 = Worksheets("Blad2")

iCell = ws2.Cells.Find(What:="*", SearchOrder:=xlRows, _
    SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1 'Vind de eerste lege regel


ws2.Cells(iCell, 1).Select 'selecteer de betreffede cel in kolom A
ActiveSheet.Paste 'Plak de waarden uit Blad1

End Sub

spaarie · 19 jul 2013

@r3000: Member status heeft vrij weinig met kennis niveau te maken.
Ik heb Junior Members codes zien maken voor Giga Seniors dus...

Mijn code is o.a. korter omdat ik me variabelen niet declareer en zoveel mogelijk .Select vermijdt.
Het vermijden van .Select en .Activate is ook een tip om dit in het vervolg te doen.
Desalniettemin vindt ik het top dat je jezelf probeert te verrijken met de kennis (zie handtekening) en natuurlijk dat je de members helpt.

Vergelijk onderstaande (jouw code door mij ingekort) met je eigen code en zie wat er anders kan:

Code:

Sub Invoeren()

Dim iCell As Long, ws As Worksheet, ws2 As Worksheet

Set ws = Worksheets("Blad1")
Set ws2 = Worksheets("Blad2")

ws.Columns("A:A").SpecialCells(xlCellTypeConstants, 23).Copy 'kopieer de waarden
iCell = ws2.Cells.Find("*", xlRows, xlPrevious, xlValues).Row + 1 'Vind de eerste lege regel

ws2.Cells(iCell, 1).Paste 'Plak de waarden uit Blad1

End Sub

r3000 · 19 jul 2013

Dank je spaarie!

Roy 1977 · 19 jul 2013

Geweldig, ga hem zsm testen!

Roy 1977 · 19 jul 2013

Bekijk bijlage ontvangst-foto2.xlsmSuper bedankt! Dit gaat mij echter echt boven mijn pet en ik krijg het niet voor elkaar. Heb het originele bestand nog eens bijgevoegd met daarin de hele code. Zou er nog eens iemand naar willen kijken? Zou geweldig gewaardeerd worden.

fijn weekend vast
Roy

spaarie · 22 jul 2013

Hiermee redt je het wel denk...

Code:

Sub Spaarie()
    Sheets("Snelscannen hulp").Columns(1).ClearContents
    With Sheets("Snelscannen")
    .Range("A1").TextToColumns .Range("A1"), xlDelimited, xlDoubleQuote, , , , , , True, "}", Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
        1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1)), True
    .Range(.Cells(1, 1), .Cells(1, .UsedRange.Columns.Count)).Copy
    End With
    
    Sheets("Snelscannen hulp").Cells(1).PasteSpecial xlPasteAll, xlNone, False, True
    
    lrow_a = Sheets("Scan Ontvangen").Range("A" & Rows.Count).End(xlUp).Row
    lrow_b = Sheets("Scan Ontvangen").Range("B" & Rows.Count).End(xlUp).Row
    If lrow_a > lrow_b Then Sheets("Snelscannen hulp").Columns(1).SpecialCells(2).Copy Sheets("Scan ontvangen").Range("A" & Sheets("Scan ontvangen").Range("A" & Rows.Count).End(xlUp).Row).Offset(1)
    If lrow_b > lrow_a Then Sheets("Snelscannen hulp").Columns(1).SpecialCells(2).Copy Sheets("Scan ontvangen").Range("A" & Sheets("Scan ontvangen").Range("B" & Rows.Count).End(xlUp).Row).Offset(1)
End Sub

Roy 1977 · 22 jul 2013

Wat een service, helemaal geweldig! Ben even de deur uit een paar dagen, maar ga het deze week testen en laat het weten!

Nogmaals dank!

Roy 1977 · 24 jul 2013

Helaas, krijg het nog niet voor elkaar. Hoop dat je nog kunt helpen. Wat ik in feite doe/wil is:

1. Sheet "Snelscannen hulp" maak kolom A leeg
2. Sheet snelscannen, selecteer Cel A1: tekst naar kolommen, gescheiden, scheidingsteken overige: }
3. Sheet snelscannen: kopieer alle gevulde cellen in rij 1
4. sheet snelscannen hulp: selecteer cel A1, plakken speciaal, waarden + transponeren
5. sheet snelscannen hulp: kopieer alle gevulde cellen in kolom A
4. Sheet scan ontvangen: plak (waarden) in de eerst vrije cel in kolom A gebasseerd op kolom A of B (in dit geval zou er dus geplakt moeten worden in A49, zie nieuw attachment)

Hoop dat dit duidelijk is en nogmaals zeer bedankt voor jullie tijd!
gr
Roy

spaarie · 24 jul 2013

Hierbij;

Code:

Sub Spaarie()
    Sheets("Snelscannen hulp").Columns(1).ClearContents
    With Sheets("Snelscannen")
    .Range("A1").TextToColumns Destination:=.Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="}", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
        1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1)), _
        TrailingMinusNumbers:=True
    .Range(.Cells(1, 1), .Cells(1, .UsedRange.Columns.Count)).Copy
    End With
    
    Sheets("Snelscannen hulp").Cells(1).PasteSpecial xlValues, , , True
    
    lrow_a = Sheets("Scan Ontvangen").Range("A" & Rows.Count).End(xlUp).Row
    lrow_b = Sheets("Scan Ontvangen").Range("B" & Rows.Count).End(xlUp).Row
    If lrow_a > lrow_b Then Sheets("Snelscannen hulp").Columns(2).SpecialCells(2).Copy Sheets("Scan ontvangen").Range("A" & Sheets("Scan ontvangen").Range("A" & Rows.Count).End(xlUp).Row).Offset(1)
    If lrow_b > lrow_a Then Sheets("Snelscannen hulp").Columns(2).SpecialCells(2).Copy Sheets("Scan ontvangen").Range("A" & Sheets("Scan ontvangen").Range("B" & Rows.Count).End(xlUp).Row).Offset(1)
End Sub

Roy 1977 · 24 jul 2013

Dank! Hij lijkt een stuk verder te komen, maar op:

Sheets("Snelscannen hulp").Columns(2).SpecialCells(2).Copy Sheets("Scan ontvangen").Range("A" & Sheets("Scan ontvangen").Range("B" & Rows.Count).End(xlUp).Row).Offset(1)

Geeft hij foutmelding: fout 1004 tijdens uitvoering: Er zijn geen cellen gevonden.

Hij plakt de data niet in de sheet "Scan ontvangen".

grt!

spaarie · 24 jul 2013

Stomme fout van mezelf... (SpecialCells(2) = waardes en je wilt formules kopieren

)
Aangepast:

Code:

Sub Spaarie()
    Sheets("Snelscannen hulp").Columns(1).ClearContents
    With Sheets("Snelscannen")
    .Range("A1").TextToColumns Destination:=.Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="}", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
        1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1)), _
        TrailingMinusNumbers:=True
    .Range(.Cells(1, 1), .Cells(1, .UsedRange.Columns.Count)).Copy
    End With
    
    Sheets("Snelscannen hulp").Cells(1).PasteSpecial xlValues, , , True
    
    lrow_a = Sheets("Scan Ontvangen").Range("A" & Rows.Count).End(xlUp).Row
    lrow_b = Sheets("Scan Ontvangen").Range("B" & Rows.Count).End(xlUp).Row
    With Sheets("Snelscannen hulp")
        If lrow_a > lrow_b Then
            .Range("B1:B" & .Range("A" & Rows.Count).End(xlUp).Row).Copy
            Sheets("Scan Ontvangen").Cells(lrow_a, 1).Offset(1).PasteSpecial xlValues
        End If
        If lrow_b > lrow_a Then
            .Range("B1:B" & .Range("A" & Rows.Count).End(xlUp).Row).Copy
            Sheets("Scan Ontvangen").Cells(lrow_b, 1).Offset(1).PasteSpecial xlValues
        End If
    End With
End Sub

Roy 1977 · 24 jul 2013

Geweldig, je bent een held! Hartelijk dank!

Data kopiëren met VBA

Roy 1977

Gebruiker

r3000

Gebruiker

spaarie

Terugkerende gebruiker

r3000

Gebruiker

spaarie

Terugkerende gebruiker

r3000

Gebruiker

Roy 1977

Gebruiker

Roy 1977

Gebruiker

spaarie

Terugkerende gebruiker

Roy 1977

Gebruiker

Roy 1977

Gebruiker

Bijlagen

spaarie

Terugkerende gebruiker

Roy 1977

Gebruiker

spaarie

Terugkerende gebruiker

Roy 1977

Gebruiker

Nieuwste berichten

Wij waarderen jouw privacy