Cellen kopieren met een formule

Status
Niet open voor verdere reacties.
D

dinge

Gebruiker
Lid geworden
11 nov 2016
Berichten
30
Goedendag

Ik heb weer een probleempje waar ik zelf helaas niet aan uit kom.
Ik wil een bereik kopieren van het tabblad uitslag naar het tabblad totale ranking.
Gegevens van het tabblad uitslag komen van het tabblad inschrijvingen.
Omdat het een scoresheet is over 4 wedstrijden had ik in kolom K op het tabblad uitslag een formule gezet die het type wedstrijd aangeeft.
Nu wil ik via een knop de ingevulde cellen en de cellen met de formule kopieren naar het tabblad totale ranking.

Dit lukt me aardig.
Alleen de cellen zonder waarde en waar alleen een formule in staat worden ook mee gekopieerd.
En dat is niet de bedoeling.
Alles zou mooi onder elkaar gezet moeten worden zoals de kolommen B t/m J wel doen.
Kolom K van het tabblad uitslag word gekopieerd naar Kolom A van het tabblad totale ranking.

Kan iemand mij vertellen hoe ik dit op kan lossen?
Heb al geprobeerd om kolom K via een formule met VBA te vullen wanneer de kolommen A, C t/m J ook gegevens bevatten, maar dat lukt me niet.
Heb ook al geprobeerd om de waarde te laten plakken, helaas zonder resultaat.

Hieronder een voorbeeld bestand.
In dit bestand zie je dat in kolom A op het tabblad totale ranking cellen staan zonder inhoud, terwijl hier wel wat had moeten staan.
Bekijk bijlage Map2.xlsm
 
doet ie zo wat je wilt?
Code: 
Sub UitslagenKopierenNaarTotaleRanking()
Dim a As Integer
Dim b As Long
Dim LegeRegel As String

'Blad onbeveiligen
Worksheets("Totale ranking").Unprotect

Worksheets("Uitslag").Range("A7", Worksheets("Uitslag").Range("A7").End(xlDown)).Copy
Worksheets("Totale ranking").Range("B7").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteAll
Range("A1").Select
Worksheets("Uitslag").Range("C7", Worksheets("Uitslag").Range("J7").End(xlDown)).Copy
Worksheets("Totale ranking").Range("C7").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteAll
Range("A1").Select

X = 7
Do
Worksheets("Uitslag").Cells(X, 11).Copy
Worksheets("Totale ranking").Range("A7").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
X = X + 1
Loop Until Worksheets("Uitslag").Cells(X, 11).Value = ""

Range("A1").Select


MsgBox ("Deelnemers gekopieerd naar totale ranking")
End

Einde:
Worksheets("Totale ranking").Protect

End Sub
 
Of:
Code: 
Sub hsv()
Dim hs_v
With Sheets("uitslag")
     .Cells(7, 1).CurrentRegion.Offset(1).Resize(.Cells(Rows.Count, 1).End(xlUp).Row - 6).Name = "bereik"
hs_v = Application.Transpose(Split(Join([transpose(row(bereik)-6)])))
     Sheets("totale ranking").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize([bereik].Rows.Count, 10) = Application.Index([bereik], hs_v, Array(11, 2, 3, 4, 5, 6, 7, 8, 9, 10))
 End With
End Sub
 
Goedenavond

Dank je wel heren de geboden oplossingen doen datgene wat ik voor ogen had.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan