Copy only Used Parts of a Range

[someone3426]

I'm making a project where there's a list of skills and next to each skill is a cell where the user can put how many skill points are in that particular skill. Now, on a separate worksheet is the place where it shows the consolidation of what skills they know, and how many points are in each. My question is, how can I copy over these skills and how many ranks are in each, without copying over the skills in which they put no points.

[rwgrietveld]

If you have a first Worksheet that looks like

... then please explain

shows the consolidation of what skills they know

[someone3426]

My list of the skill names are simply A121:A218 on a worksheet called Design, and their skill levels are B121:B128 on the same worksheet. There is only one person who has the skills, with the skill name being on the left, and their skill level being on the right. The destinations of the skill names are BI16:BI148, where rows are merged into twos (the cells are BI16, BI18, BI20) and the destinations of their corresponding levels are CD16:CD148, where the rows are once again merged into twos. Their destinations are on a worksheet called Character Sheet I. I'm not sure how to do the HTML thing you did, but if that's what you were looking for, let me know how and I will.

[Palmetto]

You'll get a precise solution much faster if you upload a sample workbook (desensitize the data) that duplicates your current structure exactly and manually shows the desired results.

[someone3426]

Is this what you're looking for? (I'm new here, and not generally good at posting in forums.)

[Leith Ross]

Hello someone3426,

Copy the macro into a VBA module and then add a button to your worksheet and attach the macro to it.

Sub CopySkills()

  Dim DstRng As Range
  Dim I As Long
  Dim N As Long
  Dim SrcRng As Range
  
    Set SrcRng = Worksheets("Design").Range("A121:A218")
    Set DstRng = Worksheets("Character Sheet 1").Range("BI16")
     
     N = 16
     For I = 1 To SrcRng.Rows.Count
       If SrcRng.Cells(I, 2) <> 0 Then
          DstRng.Offset(N, 0) = SrcRng.Cells(I, 1)
          DstRng.Offset(N, 21) = SrcRng.Cells(I, 2)
          N = N + 2
       End If
     Next I
     
End Sub