• 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.

Tabel in lijst weergeven

Status
Niet open voor verdere reacties.

patje8

Gebruiker
Lid geworden
31 jul 2005
Berichten
428
Hallo,

Ik heb een tabel (tabblad vers vlees) die wekelijks ingevuld word met de gewichten van leveranciers.
Nu wil ik graag dat deze tabel in een lijstvorm komt in een ander tabblad (Lijst).
Liefst met een macro. Kan iemand me helpen aub.
Dank UBekijk bijlage overzicht.xlsx
 
Bv

Code:
Sub VenA()
  Dim j As Long, jj As Long, t As Long, c00 As String, ar, ar1
  ar = Sheets("Vers Vlees").Cells(1).CurrentRegion
  ReDim ar1(UBound(ar) * 5, 5)
  For j = 3 To UBound(ar) - 1
    If ar(j, 1) <> "" Then c00 = ar(j, 1)
    For jj = 3 To 7
      If ar(j, jj) <> "" Then
        ar1(t, 0) = Format(ar(2, jj), "mmmm")
        ar1(t, 1) = ar(2, jj)
        ar1(t, 2) = c00
        ar1(t, 3) = ar(j, 2)
        ar1(t, 5) = ar(j, jj)
        t = t + 1
      End If
    Next jj
  Next j
  Sheets("Lijst").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(t, 6) = ar1
End Sub
 
Dit werkt perfect maar kan dit ook ipv naar een ander tabblad naar een ander bestand?

Heb geprobeerd met volgende code maar dit lukt niet.

Code:
Sub VenA()
  Dim j As Long, jj As Long, t As Long, c00 As String, ar, ar1
  
  ActWb = ActiveWorkbook.Name
  Select Case Workbooks.Count
        Case 1
            MsgBox "Er is geen ander werkblad open", vbInformation, "Geen ander werkblad open"
            Exit Sub
        Case Else
  
  
  ar = Sheets("Vers Vlees").Cells(1).CurrentRegion
  ReDim ar1(UBound(ar) * 5, 5)
  For j = 3 To UBound(ar) - 1
    If ar(j, 1) <> "" Then c00 = ar(j, 1)
    For jj = 3 To 7
      If ar(j, jj) <> "" Then
        ar1(t, 0) = Format(ar(2, jj), "mmmm")
        ar1(t, 1) = ar(2, jj)
        ar1(t, 2) = c00
        ar1(t, 3) = ar(j, 2)
        ar1(t, 5) = ar(j, jj)
        t = t + 1
      End If
    Next jj
  Next j
  Workbooks(ActWb).Worksheets("LIJST").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(t, 6) = ar1
  End Select
End Sub
 
Alle gegevens worden in de variabele ar1 opgeslagen en kan je dus in elk willekeurig excelbestand zetten.
 
nee, ik bedoel dat ik de tabel in bestand 1 wil overzetten in een lijst in bestand 2
 
Code:
Sub VenA()
  Dim j As Long, jj As Long, t As Long, c00 As String, c01 As String, ar, ar1
  c01 = "E:\Temp\Verzamel.xlsx"
  ar = Sheets("Vers Vlees").Cells(1).CurrentRegion
  ReDim ar1(UBound(ar) * 5, 5)
  For j = 3 To UBound(ar) - 1
    If ar(j, 1) <> "" Then c00 = ar(j, 1)
    For jj = 3 To 7
      If ar(j, jj) <> "" Then
        ar1(t, 0) = Format(ar(2, jj), "mmmm")
        ar1(t, 1) = ar(2, jj)
        ar1(t, 2) = c00
        ar1(t, 3) = ar(j, 2)
        ar1(t, 5) = ar(j, jj)
        t = t + 1
      End If
    Next jj
  Next j
  With GetObject(c01)
    .Sheets("Lijst").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(t, 6) = ar1
    .Save
  End With
End Sub
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan