Macro zoeken en knippen en plakken naar ander blad

[Danielle22]

Hallo allemaal,

Ik heb ook al eens een keer een soortgelijke vraag gesteld, maar ik zoek nu een iets andere benadering. Daarom post ik deze vraag nog even opnieuw:

Ik heb een bestand (zie bijlage) met verschillende tabbladen. In deze tabbladen (in het voorbeeldbestand de bladen "Testen 1 en Testen 2") moet die in kolom B (SOORT) zoeken naar de "F". Als die gevonden is dan moet die de waarden vanaf kolom B t/m U knippen en plakken naar het blad "uitval".

In ieder geval alvast heel erg bedankt voor de eventuele mogelijkheden.

Groetjes,

Danielle

Bekijk bijlage Test.xlsx

 

[HSV]

In blad uitval heb je kolom A er ook in staan, of is dat een foutje.

Sub hsv()
Dim sh As Worksheet
For Each sh In Sheets(Array("testen 1", "testen 2"))
  With sh.Cells(1).CurrentRegion
   .AutoFilter 2, "F"
   .Offset(1).Copy Sheets("uitval").Cells(Rows.Count, 1).End(xlUp).Offset(1)
   .AutoFilter
  End With
Next sh
End Sub

 

[Danielle22]

Oh ja dat is een foutje. Die moet eigenlijk niet meegenomen worden.

Dus alleen de kolommen B t/m U moeten dan geknipt en geplakt worden. Is dat ook mogelijk?

 

[HSV]

Als er in kolom V toch niets staat of komt te staan?

.offset(1[COLOR=#ff0000],[SIZE=3]1[/SIZE][/COLOR]).copy Sheets("uitval").Cells(Rows.Count, 1).End(xlUp).Offset(1)

anders:

[COLOR="#FF0000"].offset(1,1).resize(,20)[/COLOR].copy Sheets("uitval").Cells(Rows.Count, 1).End(xlUp).Offset(1)

 

[Danielle22]

Oke super bedankt.

Kunnen de waarden ook geknipt en geplakt worden? Ze worden nu gekopieerd namelijk.

 

[VenA]

En morgen moet het weer vanaf rij 10? Knippen en plakken is iets anders dan kopiëren en plakken. Dus wat moet het worden?

.cut

 

[HSV]

.cut

Daar ga je nat @VenA.

 

[Danielle22]

Haha nee dat niet hoor

Ja ik had .cut ook al geprobeerd maar dan wordt alles geknipt en geplakt..

Het moet eigenlijk geknipt en geplakt worden

 

[HSV]

Een keer wat anders.

Sub hsv()Dim sh As Worksheet, rw As Long
Application.DisplayAlerts = False
For Each sh In Sheets(Array("testen 1", "testen 2"))
rw = Sheets("uitval").Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
  With sh
    .Range("VI1:VI2") = Application.Transpose(Array("SOORT", "F"))
    .Cells(1).CurrentRegion.Offset(, 1).AdvancedFilter 2, .Range("VI1:VI2"), Sheets("uitval").Cells(rw, 1)
     Sheets("uitval").Rows(rw).Delete
    .Cells(1).CurrentRegion.AdvancedFilter 1, .Range("VI1:VI2")
    .Range("VI1:VI2").ClearContents
     On Error Resume Next
    .Cells(1).CurrentRegion.Offset(1).SpecialCells(12).Delete
    .ShowAllData
  End With
Next sh
Application.DisplayAlerts = True
End Sub

of toch maar.

Sub hsv()
Dim sh As Worksheet
Application.DisplayAlerts = False
For Each sh In Sheets(Array("testen 1", "testen 2"))
  With sh.Cells(1).CurrentRegion
   .AutoFilter 2, "F"
   .Offset(1, 1).Resize(, 20).Copy Sheets("uitval").Cells(Rows.Count, 1).End(xlUp).Offset(1)
   .Offset(1).SpecialCells(12).Delete
   .AutoFilter
  End With
Next sh
Application.DisplayAlerts = True
End Sub

 

[Danielle22]

Ik gebruik nu deze code:

Sub hsv()
Dim sh As Worksheet
Application.DisplayAlerts = False
For Each sh In Sheets(Array("testen 1", "testen 2"))
  With sh.Cells(1).CurrentRegion
   .AutoFilter 2, "F"
   .Offset(1, 1).Resize(, 20).Copy Sheets("uitval").Cells(Rows.Count, 1).End(xlUp).Offset(1)
   .Offset(1).SpecialCells(12).Delete
   .AutoFilter
  End With
Next sh
Application.DisplayAlerts = True
End Sub

Maar soms zijn er verborgen kolommen. Deze worden dan niet gekopieerd. Ik kan ook niet eerst alles zichtbaar maken, dan de code uitvoeren en dan de kolommen weer verbergen, omdat elke gebruiker zijn eigen kolommen verbergt.

Kan het ook dat de code rekening houdt met eventuele verborgen kolommen?

 

[snb]

Een alternatief:

Sub M_snb()
  c00 = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0 Xml"""
  c01 = "SELECT * FROM `Testen ~$` where [soort]='F'"
    
  For j = 1 To 2
    With CreateObject("adodb.recordset")
      .Open replace(c01,"~",j), c00
      Blad4.Cells(Rows.Count, 1).End(xlUp).Offset(1).CopyFromRecordset .DataSource
    End With
  Next
End Sub

 

[Danielle22]

Heel erg bedankt.

Wat moet ik aanpassen in de code als ik de waarden die een F bevat wil knippen vanaf kolom C.

De kolommen A en B moeten blijven staan en vanaf kolom C moeten ze dan geknipt en geplakt worden.

Is dat ook mogelijk?

Groetjes,

Danielle

 

[snb]

Wat is er ingewikkeld aan het verwijderen van de eerste 2 kolommen ?

 

[Danielle22]

Er moet eigenlijk vanaf kolom C geknipt en geplakt worden. A en B moet in de test bladen blijven staan en vanaf kolom C moet geknipt en dan weer geplakt in het blad uitval.

Maar geen idee of dat wel mogelijk is hoor.

 

[VenA]

Hoe je kolommen of rijen kan verschuiven staat toch al in #4?