Excel VBA kolommen verspringen

[Langerakpc]

Ik heb in het verleden een macro gekregen waarmee ik bulk data kan verwerken.
http://gathering.tweakers.net/forum/list_messages/1635243
Ik heb de macro naar onze eisen aangepast maar ik loop tegen een nieuw probleem aan.

Ik ben weer helemaal terug naar de basis gegaan omdat het om een ander soort verwerken gaat.
Ik heb weer dezelfde hoeveelheid data maar met enkele aanpassingen.
1. In plaats van 1 kolom (B204:B304) heb ik 2 kolommen (b204:c304).
2. Nu wordt de data keurig elke keer in de kolom naast elkaar gezet maar het moet als volgt worden:

Kolom A en B data 1
Kolom C t/m F leeg (4 kolommen)
kolom G en H data 2 etc.

het lukt me niet om de basis macro zo aan te passen dat hij ook de kolommen verspringt.

Visual Basic:

Sub importeren()

    Sheets("ruwe data").Select

    Range("B1:ZZ393").ClearContents

    With Application.FileDialog(msoFileDialogOpen)
        .InitialFileName = sPath
        .Title = sTitle
        .AllowMultiSelect = True
         
        If .Show = -1 Then
             ' Open the files
            For lngcount = 1 To .SelectedItems.Count
                
                Call Import(.SelectedItems(lngcount), "DATA" & lngcount)
                
                Sheets("DATA" & lngcount).Range("B204:B304").Copy
                Sheets("ruwe data").Cells(2, lngcount + 1).PasteSpecial Paste:=xlPasteValues
                
                Sheets("ruwe data").Cells(1, lngcount + 1).value = Sheets("DATA" & lngcount).Cells(10, 2).Text & " " & Sheets("DATA" & lngcount).Cells(11, 2).Text
                
            Next lngcount
            
        End If
         
    End With

End Sub

Sub DataBladen()

    Dim ws As Worksheet
    Dim i As Integer

    For i = 1 To 100
        Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        ws.name = "DATA" & i
    Next

End Sub

Private Sub Import(filename As String, sheetname As String)

    Sheets(sheetname).Cells.Clear
    Sheets(sheetname).Activate

    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & filename, _
        Destination:=Range(sheetname & "!$A$1"))
        .name = "20131202oasense 20131203 001 00199_1"
        .FieldNames = True
        .TextFilePlatform = 932
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With

End Sub

[ajakkes]

Wat denk je dat waar gebeurd in je script. Welke regels begrijp je wel. Hoe zou je zelf opschrijven dat het moet gebeuren als jij het honderd keer exact hetzelfde moest doen.

Kortom: wat heb je zelf geprobeerd, of verwacht je een vis ipv te leren vissen.

[Langerakpc]

Allereerst wordt er per bestand een tabblad gemaakt.
kan varieren van 10 tot paar honderd.
Dit is aan te passen in de regel For i = 1 To 100.
Ook de naam is aan te passen ws.name = "DATA" & i

Visual Basic:

Sub DataBladen()

    Dim ws As Worksheet
    Dim i As Integer

    For i = 1 To 100
        Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        ws.name = "DATA" & i
    Next

End Sub

Dan komt het importeren zelf met de instellingen.
Instellingen zijn:
Dit zal niet wijzigen omdat alle bestanden dezelfde opbouw hebben.

Visual Basic:

Private Sub Import(filename As String, sheetname As String)

    Sheets(sheetname).Cells.Clear
    Sheets(sheetname).Activate

    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & filename, _
        Destination:=Range(sheetname & "!$A$1"))
        .name = "20131202oasense 20131203 001 00199_1"
        .FieldNames = True
        .TextFilePlatform = 932
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With

End Sub

Hieronder zit het antwoord ergens verstopt.
1. Eerst wordt het tab waar de geselecteerde dat komt te staan leeg gehaald.
2. Dan verschijnt de verkenner waar ik de gewenste bestanden selecteer om te importeren.
3. eerste bestand gaat naar data 1 2de naar data 2 etc.
4.

Visual Basic:

Sheets("DATA" & lngcount).Range("B204:B304").Copy

hier bepaal ik wat er gekopieerd moet worden. In het nieuwe bestand dus b204:c304
5.

Visual Basic:

Sheets("ruwe data").Cells(2, lngcount + 1).PasteSpecial Paste:=xlPasteValues

Hier bepaal ik de eerste rij/kolom waar er geplakt moet worden.
(2, lngcount + 1) dit is Rij 3 kolom B
6.

Visual Basic:

Sheets("ruwe data").Cells(1, lngcount + 1).value = Sheets("DATA" & lngcount).Cells(10, 2).Text & " " & Sheets("DATA" & lngcount).Cells(11, 2).Text

Hier bepaal ik de titel van elke data reeks. En zoals in punt 5 waar deze dient te komen.
7. En dan herhaald hij alles naar de volgende data blad tot de laatste.

Visual Basic:

Sub importeren()

    Sheets("ruwe data").Select

    Range("B1:ZZ393").ClearContents

    With Application.FileDialog(msoFileDialogOpen)
        .InitialFileName = sPath
        .Title = sTitle
        .AllowMultiSelect = True
         
        If .Show = -1 Then
             ' Open the files
            For lngcount = 1 To .SelectedItems.Count
                
                Call Import(.SelectedItems(lngcount), "DATA" & lngcount)
                
                Sheets("DATA" & lngcount).Range("B204:B304").Copy
                Sheets("ruwe data").Cells(2, lngcount + 1).PasteSpecial Paste:=xlPasteValues
                
                Sheets("ruwe data").Cells(1, lngcount + 1).value = Sheets("DATA" & lngcount).Cells(10, 2).Text & " " & Sheets("DATA" & lngcount).Cells(11, 2).Text
                
            Next lngcount
            
        End If
         
    End With

End Sub

Ik denk zelf dat het in de volgende regel dient te komen.

Visual Basic:

Sheets("ruwe data").Cells(2, lngcount + 1).PasteSpecial Paste:=xlPasteValues

Wat ik heb geprobeerd zonder succes:
1. Een .Offset voor de kolom
2. https://groups.google.com....office.excel/FT9balwvn_w
3. https://msdn.microsoft.co...rary/office/ff840060.aspx

Ik ben nog zoekende naar verdere info op het web. En ben aan het proberen met punt 3.
Ik kan natuurlijk ook 1 van de 2 onderzochte onderdelen verkeerd hebben toegepast.