• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

vreemd resultaat

Status
Niet open voor verdere reacties.

lexcellern

Gebruiker
Lid geworden
15 okt 2015
Berichten
130
Ik heb een macro in excel die diverse handelingen uitvoert en uiteindelijk een bestand in .csv utf8 formaat moet opslaan.
Deze macro kopieert o.a. eerst een selectie van rijen, voert diverse handelingen uit en en slaat dit op, op een geopende file die al in .csv utf8 was opgeslagen.

Het vreemde is dat als ik meer dan 1 rij selecteer, dan gaat het allemaal prima.
Selecteer ik maar 1 rij, dan gaat het niet goed. De opgeslagen file, die uit heel weinig data zou moeten bestaan, geeft een geheugen weer van enkele MB's, terwijl als ik meer dan 1 regel selecteer, dan is het geheugen maar 1 kb, zoals het behoort te zijn. Gewoon een klein bestandje, opgeslagen in .csv utf8, dat ik kan gebruiken om te importeren.
Bijzonder vreemd dat het zoveel mb's zou hebben. Als je in het bestand kijkt, zie je alleen maar 1 kopregel en 1 rij (die gekopieerd is) staan. De rest lijkt leeg.

Wat gaat er fout in de macro?
Vergeef me voor de waarschijnlijk veel te omslachtige code; we hebben dit, als leken op het gebied van vba gemaakt, maar zoals gezegd, het werkt prima, wanneer er meer dan 1 rij geselecteerd wordt.
Bij selectie van maar 1 rij, lijkt

De code van de macro:

Code:
Sub VulImport()

    Dim wb As Workbook: Set wb = ThisWorkbook

    Dim ws As Worksheet

    Set ws = Application.ActiveSheet

    Dim LastRow As Long
    Dim LastRow2 As Long

'   Kopieer alle geselecteerde rijen naar worksheet "temp"
    Selection.Copy Destination:=Sheets("temp").Range("A1")
    
        With Sheets("Import")

        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        
      

        For i = 2 To LastRow + 1
        
        .Cells(i, "A").Value = ""

        .Cells(i, "B").Value = ""

        .Cells(i, "C").Value = ""

        .Cells(i, "D").Value = ""

        .Cells(i, "F").Value = ""

        .Cells(i, "G").Value = ""

        .Cells(i, "H").Value = ""

        .Cells(i, "I").Value = ""

        .Cells(i, "J").Value = ""

        .Cells(i, "K").Value = ""

        .Cells(i, "L").Value = ""

        .Cells(i, "S").Value = ""

        Next i

 

    LastRow2 = Sheets("temp").Cells(Rows.Count, "K").End(xlUp).Row
    
    For j = 2 To LastRow2 + 1
        
        .Cells(j, "A").Value = Sheets("temp").Cells(j - 1, "K").Value

        .Cells(j, "B").Value = Sheets("temp").Cells(j - 1, "O").Value

        .Cells(j, "C").Value = Sheets("temp").Cells(j - 1, "N").Value

        .Cells(j, "D").Value = Sheets("temp").Cells(j - 1, "M").Value

        .Cells(j, "F").Value = Sheets("temp").Cells(j - 1, "P").Value

        .Cells(j, "G").Value = Sheets("temp").Cells(j - 1, "Q").Value

        .Cells(j, "H").Value = Sheets("temp").Cells(j - 1, "R").Value

        .Cells(j, "I").Value = Sheets("temp").Cells(j - 1, "T").Value

        .Cells(j, "J").Value = Sheets("temp").Cells(j - 1, "U").Value

        .Cells(j, "K").Value = Sheets("temp").Cells(j - 1, "AR").Value

        .Cells(j, "L").Value = Sheets("temp").Cells(j - 1, "AS").Value

        If Sheets("temp").Cells(j - 1, "V").Value = "Nederland" Then
            .Cells(j, "E").Value = "NL"
            .Cells(j, "M").Value = 3085
        ElseIf Sheets("temp").Cells(j - 1, "V").Value = "België" Then
            .Cells(j, "E").Value = "BE"
            .Cells(j, "M").Value = 4950
        End If
        

    Next j

   

        End With

   
Application.DisplayAlerts = False

Windows("postnl.csv").Activate
    Range("A2:M2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    Windows("2020.xlsx").Activate
    Sheets("Import").Select
    Range("A2:M2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("postnl.csv").Activate
    Range("A2").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
'   ActiveWorkbook.Save
    ActiveWorkbook.SaveAs Filename:="C:\Users\Lex\postnl.csv", _
        FileFormat:=xlCSV, CreateBackup:=False, local:=True
    Windows("2020.xlsx").Activate
    Cells.Select
    Selection.ClearContents
    Sheets("september").Select

Application.DisplayAlerts = True

Sheets("temp").Cells.ClearContents
Sheets("Import").Cells.ClearContents

End Sub
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan