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

gedeelte van gegevens doorvoeren in ander werkblad

Status
Niet open voor verdere reacties.
S

schrale

Gebruiker
Lid geworden
11 aug 2001
Berichten
92
Goede middag allen ,

Is het mogelijk om de gegevens die staan onder de gele kolommen rechts in het werkblad Jan t/m Dec ook in het werkblad "overzicht opslag" terug te laten komen.
Ik heb dan een overzicht van 1 jaar wat er in opslag staat.
Ik heb eea geprobeerd maar ik wil er maar niet uit komen.

wie heeft de oplossing of wil mij op weg helpen?Bekijk bijlage OPSLAG - Ordercompleetheid.xlsx
 
Hallo Schrale,

kan je hier iets mee?
Code: 
Sub Schrale()
Sheets("overzicht opslag").Range("A4:E1000").ClearContents

Dim i As Integer
Dim lastrow As Long

For i = 1 To 12

    For Each cl In Sheets(i).Range("U7:U" & Sheets(i).UsedRange.Rows.Count)
        If cl.Value <> "" Then
        lastrow = Sheets("overzicht opslag").Range("A" & Rows.Count).End(xlUp).Row + 1
        cl.Resize(, 5).Copy Sheets("overzicht opslag").Range("A" & lastrow)
        End If
    Next cl
Next i
End Sub
 
Iets meer snelheid.
Code: 
Sub hsv()
Dim sq, sh As Worksheet, i As Long, j As Long
ReDim arr(4, 0)
For Each sh In Sheets
 If LCase(sh.Name) <> "overzicht opslag" Then
   sq = sh.Range("u7:y73")
    For i = 1 To UBound(sq)
         For j = 1 To UBound(sq, 2)
           If sq(i, j) <> "" Then
             If IsDate(sq(i, j)) Then
                 arr(j - 1, UBound(arr, 2)) = CLng(sq(i, j))
               Else
                 arr(j - 1, UBound(arr, 2)) = sq(i, j)
            End If
           End If
         Next j
         If arr(0, UBound(arr, 2)) <> "" Then ReDim Preserve arr(4, UBound(arr, 2) + 1)
        Next i
    End If
  Next sh
  With Sheets("overzicht opslag")
   .Range("a4:e" & Application.Max(4, .Cells(Rows.Count, 1).End(xlUp).Row)).ClearContents
   .Range("a4").Resize(UBound(arr, 2), 5) = Application.Transpose(arr)
  End With
End Sub
 
Sjon & HSV,

ga hier straks eens mee aan de slag.......jullie horen van mij!

Alvast hartelijk dank voor de snelle reactie!
 
Waarom is rij 6 leeg en kolom S verborgen? Hoe gestructureerde de gegevens hoe eenvoudiger de code kan zijn.

Code: 
Sub VenA()
  With Sheets("Overzicht opslag")
    .Cells(3, 1).CurrentRegion.Offset(1).ClearContents
    For Each sh In Sheets
      If sh.Name <> "Overzicht opslag" Then
        ar = sh.Range("U7:U" & Application.Max(7, sh.Cells(Rows.Count, 21).End(xlUp).Row)).Resize(, 5)
        .Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(ar), 5) = ar
      End If
    Next sh
    .Columns(1).SpecialCells(4).EntireRow.Delete
  End With
End Sub
 
@VenA,

Als je dit schrijft om de eerste twee regels te laten staan....
Code: 
.Cells(3, 1).CurrentRegion.[COLOR=#ff0000]Offset(1)[/COLOR].ClearContents

....verwijder je ze hier alsnog.
Code: 
.Columns(1).SpecialCells(4).EntireRow.Delete
 
@HSV, De TS is blijkbaar vergeten om ook A1:A2 te vullen met een paar hyperlinks:d
 
1 vraag en 3 oplossingen krijgen........
jullie zijn geweldig, precies wat ik zoek.
heb ze getest en als ik de macro draai gaat het goed.
Alleen als ik de file op sla werkt het niet
Het is de bedoeling dat als ik in welke maand dan ook ingevoerd heb,en opsla de macro draait
 
Bestand opslaan met macro's.

Zet de code in de:
Code: 
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
...code
End Sub

In Thisworkbook.
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan