VB makro til at kopiere bruge definerede kolonner via arrayet
Hej alle sammen,Jeg vil gerne oprette en makro i VBA som vil indtage et stort datasæt ind et array, bagefter vil arrayet blive resized til et nyt hvor kolonner i bruger definerede rækkefølge vil indsættes tilbage til et nyt faneblad.
Det oprindelige datasæt er på A1:AW størrelsen. Det sidste række-celle-nummer er altid ukendt.
De kolonner som jeg gerne vil sortere med til det nye faneblad er (13, 34, 28, 35, 40, 37) i det rå data.
Tabellen i det nye faneblad skal starte fra A1:F, hvor den første række står for kolonners navne (som jeg også har svært at få til at virke i den anden vba-kode nedenfor).
Jeg prøvede at kopiere-indsætte kolonner bare direkte uden at bruge arrays men pc?en går i stå da det datasæt er virkelige stort. Så nedenstående virker problematisk.
Sub CreateTabel2()
Dim wNew As Worksheet
Dim wCurrent As Worksheet
Dim mData As Range
Dim c As Range
Set wCurrent = Sheets("test")
Set mData = Range("A1:AW" & Range("AW" & Rows.Count).End(xlUp).Row)
Set wNew = Worksheets.Add
For Each c In mData
wCurrent.Range("M" & c.Row).Copy Destination:=wNew.Range("A" & c.Row)
wCurrent.Range("AH" & c.Row).Copy Destination:=wNew.Range("B" & c.Row)
wCurrent.Range("AB" & c.Row).Copy Destination:=wNew.Range("C" & c.Row)
wCurrent.Range("AI" & c.Row).Copy Destination:=wNew.Range("D" & c.Row)
wCurrent.Range("AN" & c.Row).Copy Destination:=wNew.Range("E" & c.Row)
wCurrent.Range("AK" & c.Row).Copy Destination:=wNew.Range("F" & c.Row)
Next
End Sub
Så tænkte jeg at anvende så noget i nedenstående retning, problemet er bare at jeg tidligere arbejdede kun men redimentionering af arrays med den oprindelige rækkefølge og have det svært at kopiere de bestemte kolonner. Så det bedste jeg har fundet indtil videre er at indsætte kun kolonne 13 men dette er ikke i fra A1 i det nye faneblad.
Hvis der er nogen der kan hjælpe med, så vil det være simpelthen fantastisk, da jeg er så tabt her. På forhånd tak.
Sub KopiDataSheet()
Dim lRow As Long
Dim lCol As Long
Dim rInputTable As Range 'Inputtabellen
Dim rTarget As Range 'Outputtabellen
Dim arInput() 'Array med inputtabellen
Dim arOutput() 'Array til outputtabellen
Dim vPattern As Variant
Set rInputTable = Range("A1").CurrentRegion
arInput = rInputTable.Value
Set rInputTable = Nothing
ReDim arOutput(1 To UBound(arInput), 1 To UBound(arInput, 2))
For lRow = 1 To UBound(arInput)
For lCol = 1 To UBound(arInput, 2)
If lCol = 13 Then
arOutput(lRow, lCol) = arInput(lRow, lCol)
End If
Next
Next
Worksheets.Add
Set rTarget = Range("A1").Resize(UBound(arOutput), UBound(arOutput, 2))
rTarget.Value = arOutput
End Sub