Bygge videre på makro #2
Se dette spørgsmål:http://www.eksperten.dk/spm/719916
Jeg har fået en makro fra bak der virker som ønsket, men ville gerne have at den kunne automatiseres lidt mere, så brugeren indtaster hvor mange hhv. rækker og kolonner der skal betragtes som overskrifter.
Se orginal makro fra bak i ovenstående spørgsmål (Overskrifter i 2 rækker og 2 kolonner) og en tilpasset en jeg har fået til at virke med 2 rækker og 3 kolonner.
Er der nogen der har mod på at automatisere dette?
Sub MatrixToList23()
Dim rngAll As Range
Dim rngValues As Range
Dim rngOutput As Range
Dim c As Range
Dim listen()
Dim y As Long, x As Long
y = 0
Set rngAll = Application.InputBox(prompt:="hvilket område skal listes?", Type:=8)
Set rngValues = rngAll.Offset(2, 3).Resize(rngAll.Rows.Count - 2, rngAll.Columns.Count - 3)'RETTET
x = rngValues.Cells.Count
ReDim listen(1 To x, 1 To 6)'RETTET
For Each c In rngValues
If Not CSng(c) = 0 Then
y = y + 1
listen(y, 1) = Cells(c.Row, rngAll.Column).Value
listen(y, 2) = Cells(c.Row, rngAll.Column + 1).Value
listen(y, 3) = Cells(c.Row, rngAll.Column + 2).Value'TILFØJET
listen(y, 4) = Cells(rngAll.Row, c.Column).Value'RETTET
listen(y, 5) = Cells(rngAll.Row + 1, c.Column).Value'RETTET
listen(y, 6) = c.Value'RETTET
End If
Next
Set rngOutput = Application.InputBox(prompt:="Hvortil ?", Type:=8)
rngOutput.Resize(x, 6) = listen'RETTET
End Sub
