Kopieren range naar ander tabblad met condities

Status
Niet open voor verdere reacties.

LuukVBA

Gebruiker
Lid geworden
25 okt 2021
Berichten
7
Hallo allemaal,

Ik heb even iets waar ik in vastloop.
Als het goed is kunnen jullie een foto zien die ik heb bijgevoegd.

2021-10-25_11-05-06.png

Graag wil ik de regels van kolom G tot AD kopieren naar een andere tabblad.
Met als voorwaarde dat er een nummer staat in kolom A (shipment nummer) en dat kolom B (datum) leeg is.
Als ik het goed uitgelegd heb zou dit betekenen dat alle cellen met een rode omlijning (zie foto) gekopieerd zullen worden.
Als dit allemaal gelukt is zou het nog een leuke toevoeging dat de huidige datum word weggeschreven bij de zojuist gekopieerde regels in kolom B (datum).

Alvast bedankt en ik hoor het wel of er een gepaste oplossing is.

Groetjes
 
Laatst bewerkt:
regels in een foto kun je niet kopiëren.
 
De foto is ook een screenshot van mijn excel document.
Dat leek me ter illustratie van mijn probleem even voldoende.
 
Er mist een hoop informatie, waar moet de data komen op tab 2?

Met dit voorbeeld kom je er denk ik wel
Code:
Sub jec()
 Application.ScreenUpdating = False
 With Range("A2:AD" & Range("A" & Rows.Count).End(xlUp).Row)
  .AutoFilter 1, "<>"
  .AutoFilter 2, ""
  .Offset(1).Copy Sheets(2).Range("A2")
  .Offset(, 1).Resize(, 1).SpecialCells(4) = Date
  .AutoFilter
 End With
End Sub
 
Extra toelichting

In ieder geval al bedankt!
Ik zit er nog een beetje mee te stoeien.
Dus hier nog wat extra toelichting van mij.

2021-10-26_09-33-22.png
 
Excel document

Zie bijlage.
 

Bijlagen

  • 120.XX.XXX - Test - MY Hawai - 20-10-2021.xlsm
    1,2 MB · Weergaven: 8
Misschien handig om wat data in te voeren en het wachtwoord van het VBA project af te halen.
 
Wachtwoord weg

Bij deze is het wachtwoord weg
De data staat er eigenlijk al in.
 

Bijlagen

  • 120.XX.XXX - Test 2 - MY Hawai - 26-10-2021.xlsm
    1,2 MB · Weergaven: 15
Probeer het zo eens

Code:
Sub VenA()
  Sheets("Paklijst").Cells(14, 1).CurrentRegion.Offset(1).ClearContents
  With Sheets("Data").Range("A2:AD" & Range("A" & Rows.Count).End(xlUp).Row)
    .AutoFilter 1, "<>"
    .AutoFilter 2, ""
    .Offset(1, 7).Copy
    Sheets("Paklijst").Range("B15").PasteSpecial xlValues
    .Offset(, 1).Resize(, 1).SpecialCells(4) = Date
    .AutoFilter
  End With
End Sub
 
Extra toevoeging

Stel je hebt alles gekopieerd naar het andere tabblad maar daarna word er nog een keer geklikt op de knop waaraan de macro hangt.
Dan geeft deze een foutmelding omdat er niks meer voldoet aan de criteria voor het kopieren.
Is er een snelle manier om dit op te lossen?
 
On error resume next.

Of het in de macro inbakken
Code:
Sub VenA()  Sheets("Paklijst").Cells(14, 1).CurrentRegion.Offset(1).ClearContents
  With Sheets("Data").Range("A2:AD" & Range("A" & Rows.Count).End(xlUp).Row)
    .AutoFilter 1, "<>"
    .AutoFilter 2, ""
    If .Columns(2).SpecialCells(12).Count > 1 Then
      .Offset(1, 7).Copy
      Sheets("Paklijst").Range("B15").PasteSpecial xlValues
      .Offset(, 1).Resize(, 1).SpecialCells(4) = Date
    End If
    .AutoFilter
  End With
End Sub
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan