Macro doet het niet, meerdere if statements

mmilo · 6 dec 2012

Hallo allemaal,

Ik ben bezig met een macrootje alleen stuit ik op problemen. Als ik deze macro draai dan crashed excel of herhaalt de macro zichzelf...

De bedoeling van de macro is om bepaalde informatie in de sheet "factuur" te zetten. Vervolgens wordt deze informatie naar twee locaties gekopieerd & geplakt. Eén locatie is vast en de andere is variabel (hangt af van wat er in sheet "factuur cel i25" staat). Als dit allemaal is gebeurt moet de macro opnieuw gedraaid worden voor de volgende regel met informatie.

Ik hoop dat het duidelijk genoeg is.

Mvg,
Milo

Code:

Sub factuur_maken()

Application.ScreenUpdating = False

Dim LR As Long, i As Long, j As Long, k As Long
With Sheets("Ledenbestand")
    variabel = Sheets("factuur").Range("I25").Text
    LR = .Range("A" & Rows.Count).End(xlUp).Row
    For i = 35 To LR
    For j = 4 To 1000
    For k = 4 To 1000
    
    
    'deel 1 --> factuur invullen adhv ledenbestand
    
        Sheets("Ledenbestand").Activate
            .Range("A" & i).Copy
            Sheets("Factuur").Activate
            Range("F14").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False 'Lidnummer
        
     Range("f15") = Range("f15") + 1
        
            Sheets("Ledenbestand").Activate
        .Range("U" & i).Copy
            Sheets("Factuur").Activate
            Range("J8").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False 'aanhef
        
          Sheets("Ledenbestand").Activate
        .Range("C" & i).Copy
            Sheets("Factuur").Activate
            Range("K8").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False 'Voorletters
        
        Sheets("Ledenbestand").Activate
        .Range("E" & i).Copy
            Sheets("Factuur").Activate
            Range("L8").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False 'Tussenvoegsel
        
        Sheets("Ledenbestand").Activate
        .Range("B" & i).Copy
            Sheets("Factuur").Activate
            Range("M8").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False 'Achternaam
        
         Sheets("Ledenbestand").Activate
        .Range("F" & i).Copy
            Sheets("Factuur").Activate
            Range("J9").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False 'Straat
        
          Sheets("Ledenbestand").Activate
        .Range("G" & i).Copy
            Sheets("Factuur").Activate
            Range("K9").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False 'Nummer
        
        Sheets("Ledenbestand").Activate
        .Range("H" & i).Copy
            Sheets("Factuur").Activate
            Range("J10").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False 'Postcode
        
         Sheets("Ledenbestand").Activate
        .Range("I" & i).Copy
            Sheets("Factuur").Activate
            Range("K10").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False 'Woonplaats
        
        Sheets("Ledenbestand").Activate
        .Range("Q" & i).Copy
            Sheets("Factuur").Activate
            Range("K21").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False 'Soort lid
        
         Sheets("Ledenbestand").Activate
        .Range("V" & i).Copy
            Sheets("Factuur").Activate
            Range("E21").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False 'Bedrag
        
        'printen
        
        
        'boeken factuur op 1300 rekening
        Range("H25:K25").Copy                                           '1300
        Sheets("1300").Activate
        
        If Len(Trim(Range("A" & j).Value)) = 0 Then
                Range("A" & j).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
                Range("A" & j + 1).EntireRow.Insert
        
         
              End If
              
                        
             
               Sheets("factuur").Select
              Range("h26:L26").Copy                                           'variabel
        Sheets(variabel).Activate
        
        If Len(Trim(Range("A" & k).Value)) = 0 Then
                Range("A" & k).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
                Range("A" & k + 1).EntireRow.Insert
              
              
              Exit For
              End If
             
            
            Next k
           
            Next j
            
            Next i
            
            
End With
Sheets("Ledenbestand").Select

Application.ScreenUpdating = True

End Sub

Elsendoorn2134 · 9 dec 2012

mmilo,

Ik heb eerst even je code omgezet want ik werd een beetje gek van het wisselen van de tabbladen.
Volgens mij gaat er iets niet goed door de For .. Next loops die je gebruikt.
Ik krijg de indruk dat je voor ieder lid een factuur wil maken, waarbij ieder lid 1 factuur krijgt.

Als ik naar je loops kijk dan krijgt ieder lid I (4 tot 1000) x K (4 tot 10000) = 996 x 996 = 992.016 facturen.
Dit lijkt me niet goed en het verbaast me niet dat Excel vast loopt. Ik zou hier nog even goed naar kijken.

Veel Succes.

Code:

Sub factuur_maken()

Application.ScreenUpdating = False

Dim LR As Long, i As Long, j As Long, k As Long

With Sheets("Ledenbestand")
  variabel = Sheets("factuur").Range("I25").Text
  LR = .Range("A" & Rows.Count).End(xlUp).Row
  For i = 35 To LR
    For j = 4 To 1000
      For k = 4 To 1000
    
      'deel 1 --> factuur invullen adhv ledenbestand
    
      .Range("A" & i).Copy
      Sheets("Factuur").Range("F14").PasteSpecial Paste:=xlPasteValues 'Lidnummer
      Sheets("Factuur").Range("F15") = Range("F15") + 1
        
      .Range("U" & i).Copy
      Sheets("Factuur").Range("J8").PasteSpecial Paste:=xlPasteValues  'aanhef
        
      .Range("C" & i).Copy
      Sheets("Factuur").Range("K8").PasteSpecial Paste:=xlPasteValues  'Voorletters
        
      .Range("E" & i).Copy
      Sheets("Factuur").Range("L8").PasteSpecial Paste:=xlPasteValues  'Tussenvoegsel
        
      .Range("B" & i).Copy
      Sheets("Factuur").Range("M8").PasteSpecial Paste:=xlPasteValues  'Achternaam
        
      .Range("F" & i).Copy
      Sheets("Factuur").Range("J9").PasteSpecial Paste:=xlPasteValues  'Straat
        
      .Range("G" & i).Copy
      Sheets("Factuur").Range("K9").PasteSpecial Paste:=xlPasteValues  'Nummer
        
      .Range("H" & i).Copy
      Sheets("Factuur").Range("J10").PasteSpecial Paste:=xlPasteValues 'Postcode
        
      .Range("I" & i).Copy
      Sheets("Factuur").Range("K10").PasteSpecial Paste:=xlPasteValues 'Woonplaats
        
      .Range("Q" & i).Copy
      Sheets("Factuur").Range("K21").PasteSpecial Paste:=xlPasteValues 'Soort lid
        
      .Range("V" & i).Copy
      Sheets("Factuur").Range("E21").PasteSpecial Paste:=xlPasteValues 'Bedrag
        
      'printen
      'boeken factuur op 1300 rekening
      Sheets("Factuur").Range("H25:K25").Copy                                           '1300
                
      If Len(Trim(Range("A" & j).Value)) = 0 Then
        Sheets("1300").Range("A" & j).PasteSpecial Paste:=xlPasteValues
        Sheets("1300").Range("A" & j + 1).EntireRow.Insert
      End If
              
      Sheets("factuur").Range("h26:L26").Copy                                           'variabel

        
      If Len(Trim(Range("A" & k).Value)) = 0 Then
        Sheets(variabel).Range("A" & k).PasteSpecial Paste:=xlPasteValues
        Sheets(variabel).Range("A" & k + 1).EntireRow.Insert
        Exit For
      End If
            
      Next k
    Next j
  Next i
End With

Application.ScreenUpdating = True

End Sub

mmilo · 9 dec 2012

Dank voor je reactie. Hoe zorg ik dan dat hij niet elk lid herhaalt maar de boel als een lid herhaalt?

Elsendoorn2134 · 10 dec 2012

Mmilo,

Je vraag is simpel, verwijder de for..next voor de J en de K.
Mijn vraag zou dan zijn waar je deze voor nodig hebt.
Ik gok dat je de factuurtotalen op een lege regel wil laten opslaan.
Aangezien ik je bestand zelf niet gezien heb is het een beetje lastig om me dit voor te stellen.
Met het risico een denk fout te hebben gemaakt hierbij een voorzet.
Mocht je er niet uit komen, wil je dan een (deel) van het bestand met gefingeerde adressen etc.
op deze site plaatsen.

Veel Succes.

Code:

Sub factuur_maken()

Application.ScreenUpdating = False

Dim LR As Long, i As Long, j As Long, k As Long

With Sheets("Ledenbestand")
  variabel = Sheets("factuur").Range("I25").Text
  LR = .Range("A" & Rows.Count).End(xlUp).Row
  For i = 35 To LR
    
      'deel 1 --> factuur invullen adhv ledenbestand
    
      .Range("A" & i).Copy
      Sheets("Factuur").Range("F14").PasteSpecial Paste:=xlPasteValues 'Lidnummer
      Sheets("Factuur").Range("F15") = Range("F15") + 1
        
      .Range("U" & i).Copy
      Sheets("Factuur").Range("J8").PasteSpecial Paste:=xlPasteValues  'aanhef
        
      .Range("C" & i).Copy
      Sheets("Factuur").Range("K8").PasteSpecial Paste:=xlPasteValues  'Voorletters
        
      .Range("E" & i).Copy
      Sheets("Factuur").Range("L8").PasteSpecial Paste:=xlPasteValues  'Tussenvoegsel
        
      .Range("B" & i).Copy
      Sheets("Factuur").Range("M8").PasteSpecial Paste:=xlPasteValues  'Achternaam
        
      .Range("F" & i).Copy
      Sheets("Factuur").Range("J9").PasteSpecial Paste:=xlPasteValues  'Straat
        
      .Range("G" & i).Copy
      Sheets("Factuur").Range("K9").PasteSpecial Paste:=xlPasteValues  'Nummer
        
      .Range("H" & i).Copy
      Sheets("Factuur").Range("J10").PasteSpecial Paste:=xlPasteValues 'Postcode
        
      .Range("I" & i).Copy
      Sheets("Factuur").Range("K10").PasteSpecial Paste:=xlPasteValues 'Woonplaats
        
      .Range("Q" & i).Copy
      Sheets("Factuur").Range("K21").PasteSpecial Paste:=xlPasteValues 'Soort lid
        
      .Range("V" & i).Copy
      Sheets("Factuur").Range("E21").PasteSpecial Paste:=xlPasteValues 'Bedrag
        
      'printen
      'boeken factuur op 1300 rekening
      j = Sheets("1300").Range("A" & Rows.Count).End(xlUp).Row          
 
      Sheets("Factuur").Range("H25:K25").Copy                                           '1300

      Sheets("1300").Range("A" & j).PasteSpecial Paste:=xlPasteValues
      Sheets("1300").Range("A" & j + 1).EntireRow.Insert
              
      Sheets("factuur").Range("h26:L26").Copy                                           'variabel

      j = Sheets(variabel).Range("A" & Rows.Count).End(xlUp).Row          
      Sheets(variabel).Range("A" & k).PasteSpecial Paste:=xlPasteValues
      Sheets(variabel).Range("A" & k + 1).EntireRow.Insert
            
  Next i
End With

Application.ScreenUpdating = True

End Sub

mmilo · 10 dec 2012

Bedankt. Het werkt nu perfect.

Macro doet het niet, meerdere if statements

mmilo

Gebruiker

Elsendoorn2134

Gebruiker

mmilo

Gebruiker

Elsendoorn2134

Gebruiker

mmilo

Gebruiker

Nieuwste berichten

Wij waarderen jouw privacy