cellen samenvoegen ander blad

[etimm]

Ik wil de kolommen A en B samenvoegen en gebruik hier de volgende code voor:

Sub Combineren()
Range("C3:C60000").Formula = "=RC[-2]&""/""&RC[-1]"
Range("D3:D60000").Value = Range("C3:C60000").Value
Range("C3:C60000").ClearContents
End Sub

Dit werkt lekker snel, maar ik kan de gegevens zo niet op een ander blad krijgen. Is het mogelijk om de code dusdanig te wijzigen dat er geen tussenstap nodig is?

 

[Niels28]

gegevens kunnen wel naar nader blad.

Sub Combineren()
Range("C3:C60000").Formula = "=RC[-2]&""/""&RC[-1]"
Sheets("blad3").Range("D3:D60000").Value = Range("C3:C60000").Value
Range("C3:C60000").ClearContents
End Sub

Niels

 

[etimm]

gegevens kunnen wel naar nader blad.

Sub Combineren()
Range("C3:C60000").Formula = "=RC[-2]&""/""&RC[-1]"
Sheets("blad3").Range("D3:D60000").Value = Range("C3:C60000").Value
Range("C3:C60000").ClearContents
End Sub

Niels

Is het ook mogelijk om het eerste blad niet te wijzigen? Ik doelde eigenlijk op de eerste regel code... Ik ben namelijk van plan om de gegevens gelijk in een heel ander bestand te zetten.

 

[Niels28]

Ja dat is ook mogelijk, ik had die macro al gemaakt.
Er is alleen 1 probleem, jouwe duurt 0,5 sec. bij 60000 rijen
Deze duurt 6 sec. 60000 rijen.
Misschien dat iemand een sneller manier weet.

Sub Combineren()
Application.ScreenUpdating = False
Dim irow As Long
Dim c01 As String
Dim sq As Range
Dim cl

irow = Sheets("blad1").Cells(Rows.Count, 4).End(xlUp).Row
Set sq = Sheets("blad1").Range("A3:A" & irow)
For Each cl In sq
c01 = c01 & "|" & cl.Value & "\" & cl.Offset(0, 1).Value
Next
Sheets("blad2").Range("D3:D" & irow).Value = Application.Transpose(Split(Mid(c01, 2), "|"))

End Sub

Niels

 

[Warme bakkertje]

2.06 sec

Sub Combineren()
Dim Temparray()
sq = Sheets("blad1").Range("A1:B" & Sheets("blad1").Cells(Rows.Count, 1).End(xlUp).Row)
ReDim Temparray(1 To UBound(sq))
Application.ScreenUpdating = False
For i = 1 To UBound(sq)
    Temparray(i) = sq(i, 1) & "/" & sq(i, 2)
Next
Blad2.Cells(1, 3).Resize(UBound(sq)).Value = WorksheetFunction.Transpose(Temparray)
Application.ScreenUpdating = True
End Sub