macro werkt niet bij groter bestand

Status
Niet open voor verdere reacties.
S

ssteenvoorde

Gebruiker
Lid geworden
4 mei 2018
Berichten
11
foutmelding macro.PNGfoutmelding macro.PNG

Hallo,

Een tijd geleden heb ik een macro met hulp van andere gemaakt. Deze macro was gebaseerd op een klein bestand, zie bijlage. Nu werkt de macro voor dit bestand goed. Zodra ik de gegevens op sheet ''rapportage voorkeur housing reg'' uitbreid tot bijvoorbeeld regel 4000, met dezelfde gegevens qua opmaak, dan krijg ik een foutmelding. Iemand enige idee waarom ik deze foutmelding krijg?
De macro is:

Code: 
Sub test2()
'
' Housing req rapportage
'

    Range("A1:O1").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet1").Select
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("rapportage voorkeur housing req").Select
    Range("P2:P9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet1").Select
    Range("R1").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
        Selection.Font.Bold = True
        Cells.Select
        Cells.EntireColumn.AutoFit
    Dim sv, i As Long
    sv = Sheets("rapportage voorkeur housing req").Cells(1).CurrentRegion
    For i = 2 To UBound(sv) Step 8
     With Sheets("sheet1").Cells(Rows.Count, 1).End(xlUp)
      .Offset(1).Resize(, 15) = Application.Index(sv, i, 0)
      .Offset(1, 17).Resize(, 8) = Application.Transpose(Application.Index(sv, Evaluate("row(" & i & ":" & i + 8 & ")"), 17))
     End With
    Next i
End Sub

Alvast bedankt. Groet, Shin-Lee
 

Bijlagen

  • Copy of SEA - Matchingfile (platte lijst).xlsm
    19,2 KB · Weergaven: 22
Laatst bewerkt:
Heb je bij die foutmelding al eens op de Debug knop geklikt?
Op welke regel in de code kom je dan terecht?

De code die je plaatste staat trouwens nergens in het voorbeeld document.
 
Laatst bewerkt:
Daarnaast geef je een specifiek probleem aan (macro werkt wel bij kleine tabel, niet bij grote tabel) en dan lever je een voorbeeldje aan met zo'n 6 rijen.... Hoe kunnen wij dan testen of het probleem bij ons ook bestaat? Moeten we zelf de ontbrekende 3994 regels inkloppen? Doe er op zijn minst een representatief bestand bij (met de juiste macro's :))
 
Sorry, het verkeerde bestand zat erbij :( In de bijlage het juiste bestand met de juiste gegevens en juiste macro.

Als ik op debug druk krijg ik t volgende te zien:

foutmelding macro2.PNG


Alvast bedankt!!
 

Bijlagen

  • testfile (platte lijst).xlsm
    195,2 KB · Weergaven: 27
Test het eens.
Code: 
Sub hsv()
Dim sv, arr, i As Long, j As Long, n As Long, k As Long, sh As Worksheet
Set sh = Sheets("rapportage voorkeur housing req")
sv = sh.Cells(1).CurrentRegion
   With Sheets("sheet1").Cells(1)
      .CurrentRegion.Resize(, 25).Clear
      .Resize(, 16) = sh.Cells(1).Resize(, 16).Value
      .Cells(1, 18).Resize(, 8) = sh.Cells(1, 17).Value
         ReDim arr(UBound(sv) / 8, 24) As String
            For i = 2 To UBound(sv) Step 8
                For j = 0 To 23
                  arr(n, j + IIf(j > 15, 1, 0)) = sv(i + IIf(j > 15, k, 0), j - IIf(j > 15, k - 1, -1))
                  If j > 15 Then k = k + 1
                Next j
               n = n + 1
               k = 0
            Next i
      .Offset(1).Resize(UBound(arr), 25) = arr
      .Parent.Rows(1).Font.Bold = True
      .Parent.Columns.AutoFit
   End With
End Sub
 
Beste Harry,

Super bedankt voor deze code!! Ik heb de code getest en het werkt. 1 klein puntje wat misschien nog makkelijk aangepast kan worden??
Ik krijg nu op sheet 1 in de nieuw gegeneerde kolommen als kolomnaam niet meer de juiste kolomnaam. Er komt in elke kolom voorkeuren als titel te staan ipv:
Voorkeur stad?
Voorkeur prijscategorie Leiden?
Voorkeur prijscategorie The Hague
Toelichting
Voorkeur stad 2?
Voorkeur prijs categorie Leiden 2
Voorkeur prijs categorie The Hague 2
Toelichting 2
Mocht dit niet makkelijk te verhelpen zijn kan ik het natuurlijk handmatig aanpassen :)

Groet,
Shin-Lee
 
Blauwe regel.
Code: 
Sub hsv()
Dim sv, arr, i As Long, j As Long, n As Long, k As Long, sh As Worksheet
Set sh = Sheets("rapportage voorkeur housing req")
sv = sh.Cells(1).CurrentRegion
   With Sheets("sheet1").Cells(1)
      .CurrentRegion.Resize(, 25).Clear
      .Resize(, 16) = sh.Cells(1).Resize(, 16).Value
      .Offset(, 17).Resize(, 8) = [COLOR=#0000ff]Application.Transpose(sh.Range("p2:p9"))[/COLOR]
         ReDim arr(UBound(sv) / 8, 24) As String
            For i = 2 To UBound(sv) Step 8
                For j = 0 To 23
                  arr(n, j + IIf(j > 15, 1, 0)) = sv(i + IIf(j > 15, k, 0), j - IIf(j > 15, k - 1, -1))
                  If j > 15 Then k = k + 1
                Next j
               n = n + 1
               k = 0
            Next i
      .Offset(1).Resize(UBound(arr), 25) = arr
      .Parent.Rows(1).Font.Bold = True
      .Parent.Columns.AutoFit
   End With
End Sub
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan