Macro

[gl3nn1987]

Vraag ik heb de enkele macro hieronder die perfect werkt, nu heb ik de andere 2 opties toegevoegd (zie daaronder en dna werkt hij niet meer kan iemand helpen?)

Sub Uitzetten()
Dim c As Range
y = 2
[M!A3].CurrentRegion.ClearContents
For Each c In Sheets("cash").Range("B2:B2000")
If c = ["M"] Then
Blad6.Range("A" & y).Offset(1, 0) _
.Resize(, 15) = Blad1.Cells(c.Row, 1).Resize(, 15).Value
y = y + 1
End If
Next
End Sub






Sub Uitzetten()
Dim c As Range
y = 2
[M!A3].CurrentRegion.ClearContents
[M!A3].CurrentRegion.ClearContents
[R!A3].CurrentRegion.ClearContents
For Each c In Sheets("cash").Range("B2:B2000")
If c = ["M"] Then
Blad6.Range("A" & y).Offset(1, 0) _
.Resize(, 15) = Blad1.Cells(c.Row, 1).Resize(, 15).Value
y = y + 1
If c = ["K"] Then
Blad7.Range("A" & y).Offset(1, 0) _
.Resize(, 15) = Blad1.Cells(c.Row, 1).Resize(, 15).Value
y = y + 1
If c = ["R"] Then
Blad8.Range("A" & y).Offset(1, 0) _
.Resize(, 15) = Blad1.Cells(c.Row, 1).Resize(, 15).Value
y = y + 1
End If
Next
End Sub

 

[Haaren101]

Kan je je topic aanpassen; VGA zette me op het verkeerde been

Op het eerste gezicht niets mis mee; kan je aangeven wat er dan fout gaat?

Ron

 

[gl3nn1987]

Hij geeft de fout bij Next aan..

 

[Haaren101]

Iedere if moet door een endif worden afgesloten

Ron

 

[gl3nn1987]

Hij doet het dan wel maar dan zet hij niet netjes meer de regels onder elkaar.. Als er na de M een K komt en dan weer een M krijgen we in het M bestand een lege regel ertussen

 

[gl3nn1987]

Al zelf opgelost door de y niet telkens te gebruiken als letter

nog 1 laatste vraag. Als ik M K en R nou als aparte bestanden doe dus niet in die workbook. hoe moet ik dan naar blad1 kopieeren van M bijvoorbeeld.

 

[gl3nn1987]

Sub Uitzetten()
Dim c As Range
y = 2
o = 2
p = 2
Workbooks.Open Filename:="C:\M.xls"
Workbooks.Open Filename:="C:\K.xls"
Workbooks.Open Filename:="C:\R.xls"
Workbooks("Hoofd").Worksheets("cash").Activate
For Each c In Sheets("Excessive_cash").Range("B2:B1000")
If c = ["Mass"] Then
Workbooks("M.xls").Worksheets("cash").Range("A" & y).Offset(1, 0) _
.Resize(, 12) = Blad1.Cells(c.Row, 1).Resize(, 12).Value
y = y + 1
End If
If c = ["MKB"] Then
Workbooks("K.xls").Worksheets("cash").Range("A" & o).Offset(1, 0) _
.Resize(, 12) = Blad1.Cells(c.Row, 1).Resize(, 12).Value
y = o + 1
End If
If c = ["RM"] Then
Workbooks("R.xls").Worksheets("cash").Range("A" & p).Offset(1, 0) _
.Resize(, 12) = Blad1.Cells(c.Row, 1).Resize(, 12).Value
p = p + 1
End If
Next
Workbooks("M").Close SaveChanges:=True
Workbooks("K").Close SaveChanges:=True
Workbooks("R").Close SaveChanges:=True
End Sub