VB moet altijd actieve sheet pakken

[RobVOss]

Ik gebruik de volgende VB code:

**********************************************

Sub CopySignificant()
  Dim DestSheet        As Worksheet
  Set DestSheet = Worksheets("Bestelformulier")
  
  
  Dim sRow       As Long     'row index on source worksheet
  Dim dRow       As Long     'row index on destination worksheet
  Dim sCount     As Long
  sCount = 1
  dRow = 20
  
  If ActiveSheet.FilterMode Then
    ActiveSheet.ShowAllData
  End If
  
  'sRow = Range("D65536").End(xlUp).Row

  For sRow = 7 To Range("D65536").End(xlUp).Row
   
    If Cells(sRow, "A") <> "" Then
        sCount = sCount + 1
        dRow = dRow
        'copy cols A,F,E & D
        
        DestSheet.Rows(dRow + 1).Rows.Insert
        
       Cells(sRow, "K").Copy Destination:=DestSheet.Cells(dRow + 1, "A")
       Cells(sRow, "C").Copy Destination:=DestSheet.Cells(dRow + 1, "B")
       Cells(sRow, "D").Copy Destination:=DestSheet.Cells(dRow + 1, "C")
       Cells(sRow, "E").Copy Destination:=DestSheet.Cells(dRow + 1, "D")
       Cells(sRow, "F").Copy Destination:=DestSheet.Cells(dRow + 1, "E")
       Cells(sRow, "A").Copy Destination:=DestSheet.Cells(dRow + 1, "F")
       
       Cells(1, "C").Copy Destination:=DestSheet.Cells(dRow + 1, "G")
       
       Cells(1, "D").Copy Destination:=DestSheet.Cells(dRow + 1, "H")
       
       Cells(sRow, "A").Clear
     End If
   Next sRow
  
  MsgBox sCount - 1 & " Artikelen naar de order gekopieerd", vbInformation, "Transfer Done"

End Sub

*********************************************

Nu wil ik dit op meerdere sheets gebruiken, en dan moet excel altijd de actieve sheet als source gebruiken. Hoe doe ik dat ?

 

[OctaFish]

Allereerst welkom op het forum! Wij hebben hier de gewoonte om VBA code op te maken met de CODE knop. Zou je dat alsnog even willen doen? Die knop zie je in het opmaak scherm als je <Ga geavanceerd> gebruikt. Nu is het wel een èrg lastig leesbare lap tekst.

 

[snb]

Mij lijken 2 regels code voldoende:

Sub M_snb()
    sn = Cells(1).CurrentRegion
    sheets("Bestelformulier").Cells(20, 1).Resize(UBound(sn), 6) = Application.Index(sn, Evaluate("row(1:" & UBound(sn) & ")"), Array(11, 3, 4, 5, 6, 1))
End Sub

 

[RobVOss]

snb, ik weet niet precies wat ik met die code van jou moet. Moet ik die ergens tussenplaatsen ? Mijn kennis van VBA is nl. zeer beperkt.

 

[snb]

In plaats van jouw code: ergo vervangen.

 

[RobVOss]

snb, ik heb de code vervangen maar dat werkt niet. Er worden geen artikelen gekopieerd naar het bestelformulier, alleen de koppen in mijn bestelformulier staan ineens op #VERW!