Avatar billede Laugesen1 Mester
16. december 2013 - 21:48 Der er 1 løsning

Overfør data med VBA fra flere ark til et enkelt ark

Jeg er ved at lave en makro der samler data fra flere ark i ét enkelt ark. Kildedata ligger i et ark for hver uge. Koden skal kunne overføre data for ugerne i en hel måned og indsæt dem samlet i et enkelt ark.
Data bliver overført ud fra flere kriterier, såsom tidspunkt, ID-nr. og betalingskort.
Det er forskelligt fra uge til uge hvor mange rækker der er fra kildedata.

Kolonneoverskrifterne skal overføres til destinationsarket sammen med kildedata, kun fra 1. uge i måneden.
En mulighed er også, at kolonneoverskrifter ikke bliver overført sammen med data. Jeg kan lave dem statisk i destinationsarket, da de ikke ændre sig.

Den kode jeg arbejder med, har jeg fundet her på sitet og har forsøgt at tilpasset den.
http://www.eksperten.dk/spm/955698

Men nu er jeg stødt på nogle problemer, som jeg skal have hjælp til.

Case:
Destinationsark: Samling af data for en hel måned.
Kildeark: Indeholder hver især data for en hel uge, og er navngivet med ugenummer til sidst i navnet, fx StamExcel.49
Der skal altså overføres data fra 4-6 kildeark hver måned, alt efter hvordan ugerne er fordelt på en hel måned.

Problem 1.
Afgrænsning af data i starten og slutningen af måneden med kriterier for dato og klokkeslæt.
Fx fra 1. december kl. 00:00 til 31. december kl. 23:59.
Jeg ved ikke hvordan man laver en kode, der sorterer, så alle data med datoer der er større end fx 1. december kl. 00:00, bliver overført til destinationsarket.
De andre kriterier skal stadig være opfyldt (ID nr. og betalingskort).
Tilsvarende skal der sorteres i slutningen af måneden (mindre end 31. december kl. 23:59)

Problem 2.
Indsæt data i destinationsarket forløbende, dvs. data fra 1. uge bliver indsat fx frem til række 20 (her med start i række 2).
Derefter skal data fra 2. uge indsættes fra række 21 og videre ned. Det samme med de efterfølgende ark 2 - 4 ark.
Det sidste ark skal så sorteres, så der ikke kommer data med fra næste måned. (mindre end 31. december kl. 23:59).


Koden:
   
Option Explicit
Option Base 1

Public Sub FlytData()


    Dim RåData1 As Variant, RåData2 As Variant, Rådata3 As Variant
    Dim UdData1 As Variant, UdData2 As Variant, UdData3 As Variant
    Dim UD1 As Long, UD2 As Long, UD3 As Long
    Dim I As Integer, J As Long, X As Integer, Kol As Integer, Rk As Long
   
    UD1 = 2
    UD2 = 2
    UD3 = 2

    RåData1 = Application.Workbooks("StamExcel.49").Sheets("Kreditkort").Range("A8").CurrentRegion
    RåData2 = Application.Workbooks("StamExcel.50").Sheets("Kreditkort").Range("A8").CurrentRegion
    Rådata3 = Application.Workbooks("StamExcel.51").Sheets("Kreditkort").Range("A8").CurrentRegion
       
    Rk = UBound(RåData1, 1)
    Kol = UBound(RåData1, 2)
   
    ReDim UdData1(Rk, Kol)
    ReDim UdData2(Rk, Kol)
    ReDim UdData3(Rk, Kol)

    For I = 1 To UBound(RåData1, 2)
        UdData1(1, I) = RåData1(1, I)
    Next
    'Her skal der indsættes kriterier for dato og klokkeslæt (start på måneden, - større end 1. december kl. 00:00).
    For J = 2 To Rk
        If InStr(1, UCase(RåData1(J, 7)), "ID3456") And InStr(1, UCase(RåData1(J, 3)), "VISA/DK") Then

            For X = 1 To Kol
                UdData1(UD1, X) = RåData1(J, X)
            Next
            UD1 = UD1 + 1
        End If
    Next
   
    For I = 1 To UBound(RåData2, 2)
        UdData1(1, I) = RåData2(1, I)
    Next
    'Import af data uden kriterier for dato og klokkeslæt. Der kommer data fra 2-4 ark med samme krterier.
    For J = 2 To Rk
        If InStr(1, UCase(RåData2(J, 7)), "ID3456") And InStr(1, UCase(RåData2(J, 3)), "VISA/DK") Then

            For X = 1 To Kol
                UdData2(UD1, X) = RåData2(J, X)
            Next
            UD2 = UD2 + 1
        End If
    Next
   
    For I = 1 To UBound(Rådata3, 2)
        UdData3(1, I) = Rådata3(1, I)
    Next
    'Her skal der indsættes kriterier for dato og klokkeslæt (slut på måneden, - mindre end 31. december kl. 23:59).
    For J = 2 To Rk
        If InStr(1, UCase(Rådata3(J, 7)), "ID3456") And InStr(1, UCase(Rådata3(J, 3)), "VISA/DK") Then

            For X = 1 To Kol
                UdData3(UD3, X) = Rådata3(J, X)
            Next
            UD3 = UD3 + 1
        End If
    Next
   
    Worksheets("IndsætData").Range("A1").Resize(Rk, Kol) = UdData1
    Worksheets("IndsætData").Range("A1").Resize(Rk, Kol) = UdData2
    Worksheets("IndsætData").Range("A1").Resize(Rk, Kol) = UdData3

End Sub


Er der nogen der har et bud på en løsning ?

Laugesen
Avatar billede Laugesen1 Mester
10. januar 2014 - 00:43 #1
Lukker spørgsmål
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview
Kategori
Excel kurser for alle niveauer og behov – find det kursus, der passer til dig

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester