CSV import vraag (zet regels niet iedere keer bovenaan)

[BasSchuring]

http://filedump.org/files/EB47IcG1395153937.html

Beste Excel Goeroes,

Ik heb een bestandje in elkaar gefreubelt en hij werkt bijna zoals ik zou willen.

Ik zit alleen nog met 1 probleem. Als ik alle CVS verwerk die in de map staan. Dan print hij van de eesrte netjes de bon uit met de 2 producten op de bovenste 2 regels. Maar van de tweede CSV die hij verwerkt zet hij de producten op regels 3 en 4 en van de derde zelfs op 7 en 8. Waar zit de fout dat hij van de 2de en 3de CSV ook gelijk netjes de producten gewoon bovenaan zet voor het uitprinten??

Ik hoop dat 1 van jullie mij kan helpen!

alvast bedankt!

gr
Bas

 

[BasSchuring]

niemand?? Of ben ik ongeduldig :d

Ik heb zelf natuurlijk ook nog even zitten kijken en ik heb idee dat het probleem in dit stukje zit:

ActiveSheet.UsedRange.Copy wsMstr.Range("A1")
        wbCSV.Close False
         
        With Sheets("export shop")
        With .Range("a1:a" & .Cells(Rows.Count, 1).End(xlUp).Row)
        ReDim arr(.Rows.Count, 9)
         Set c = .Find("product", , , xlPart)
        If Not c Is Nothing Then
            firstaddress = c.Address
         Do
         If UCase(Split(c)(0)) = "PRODUCT" Then
              For j = 0 To 9
         arr(n, j) = c.Offset(j)
             Next j
                 n = n + 1
                    End If
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstaddress
               End If
                  End With
            End With
          With Sheets("gesorteerd")
             .Cells(1).CurrentRegion.ClearContents
              .Cells(1).Resize(n, 9) = arr
           .Columns(1).Resize(, 9).AutoFit
        End With

hierna print hij de werkbon en vervolgens gaat de loop opnieuw maar plaatst hij de regels dus niet in rij 1 in sheet "gesorteerd" maar onder de rijen van de vorige import.....

Maar wat ik aan moet passen is me een raadsel....

Ik hoop dat iemand mij kan vertellen waar het fout gaat....

 

[snb]

Zet svp een voorbeeldbestand in dit forum. Op ander plaatsen worden ze na verloop van tijd verwijderd en is deze draad niet meer te volgen (nog afgezien van de onveiligheid van externe downloadsites).

 

[snb]

Zet svp een voorbeeldbestand in dit forum. Op ander plaatsen worden ze na verloop van tijd verwijderd en is deze draad niet meer te volgen (nog afgezien van de onveiligheid van externe downloadsites).

Aan jouw code is geen touw vast te knopen; het begint niet met een sub en eindigt niet met een end sub.

 

[BasSchuring]

ik kan de bestanden hier niet uploaden omdat hij te groot is

hierbij de hele code

Private Sub verwerk2()

Dim wbCSV   As Workbook
Dim wsMstr  As Worksheet:   Set wsMstr = ThisWorkbook.Sheets("Export shop")
Dim fPath   As String:      fPath = "C:\Users\b.schuring\Desktop\shop csv\"
Dim fCSV    As String
Dim c As Range, firstaddress As String, j As Long, n As Long

If MsgBox("'Leeg Sheet Export shop voor inlezen CSV?", vbYesNo, "Clear?") _
    = vbYes Then wsMstr.UsedRange.Clear

Application.ScreenUpdating = True

fCSV = Dir(fPath & "*.csv")

Do While Len(fCSV) > 0
      
        Set wbCSV = Workbooks.Open(fPath & fCSV)
        ActiveSheet.UsedRange.Copy wsMstr.Range("A1")
        wbCSV.Close False
        
        Sheets("gesorteerd").Range("A:Z").ClearContents
        
        With Sheets("export shop")
        'With .Range("a1:a" & .Cells(Rows.Count, 1).End(xlUp).Row)
        With .Range("a1:a" & .Cells(Rows.Count, 1).Row)
        ReDim arr(.Rows.Count, 9)
         Set c = .Find("product", , , xlPart)
        If Not c Is Nothing Then
            firstaddress = c.Address
         Do
         If UCase(Split(c)(0)) = "PRODUCT" Then
              For j = 0 To 9
         arr(n, j) = c.Offset(j)
             Next j
                 n = n + 1
                    End If
            Set c = .FindNext(c)
        
        Loop While Not c Is Nothing And c.Address <> firstaddress
               End If
                  'End With
            'End With
          With Sheets("gesorteerd")
             .Cells(1).CurrentRegion.ClearContents
              .Cells(1).Resize(n, 9) = arr
           .Columns(1).Resize(n, 9).AutoFit
        End With
        End With
        End With

        Sheets("Filter").Select
        Selection.AutoFilter

        Application.EnableEvents = False
        With Sheets("Filter")
        Sheets("orderoverzicht").Cells(1).CurrentRegion.Offset(1).Copy
            .Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial (xlPasteValues)
            With .Cells(1).CurrentRegion
               .Value = .Value
               .Offset(1).Sort .Range("D1")
               .Columns(1).NumberFormat = "general"
               .Columns(4).NumberFormat = "dd-mm-yyyy"
                  Application.Goto .Cells(1)
End With

Sheets("werkbon").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1
'Sheets("pakbon").Select
'ActiveWindow.SelectedSheets.PrintOut Copies:=1 'Sheets("pakbon").Range("L25")

Sheets("gesorteerd").UsedRange.Clear
        
fCSV = Dir

End With

Loop

Application.ScreenUpdating = True

Sheets("Filter").Select
Cells.Select
Selection.AutoFilter

Sheets("export shop").UsedRange.Clear

End Sub

 

[snb]

Bekend met Zip ?

 

[BasSchuring]

Ja wel zoals je kan zien in de downloadlink van filedump. Ook de ZIP is te groot dus......................
Maar goed hierbij nog een link van google drive.


Dan blijft het bestand wel staan maar ben toch benieuwd of je ook de oplossing hebt nu het bestand er staat......