Macro naar twee tabbladen verlinken

[rogersmeets]

In mijn 1e blad "Teamleider-Productie Dashboard" verwijs ik met de knop opslaan naar het blad "Jaarproductie-aantal karren" daar worden wat cijfers met karren overgenomen.
Ik wil nu graag de tweede rij cijfers met m3 in het 3e tabblad "Jaarproductie-aantal m3" kopieren met dezelfde macro hoe ziet dat eruit ?

En deze macro kopieert opeens heel zenuwachtig wat gebeurd er met mijn 1e tablad, die zo verspringd ?

 Sub Button2_Click()Set sh = Sheets("Teamleider-Productie Dashboard")
With Sheets("Jaarproductie-aantal karren")
  r = Application.Match(sh.Range("e36"), .Columns(2), 0)
  If IsNumeric(r) Then
     sh.Range("f36:l36").Copy
     .Cells(r, 3).PasteSpecial xlPasteValues
 Application.CutCopyMode = False
     For Each cl In .Cells(r, 3).Resize(, 7)
       cl.Interior.Color = sh.Range("f36").Offset(, y).DisplayFormat.Interior.Color
        y = y + 1
        r = True


If r Then
MsgBox "Data gekopieerd !", vbInformation, "Copy"
Else
MsgBox "Gegeven niet gevonden !", vbExclamation, "Geen Copy"
End If
Exit Sub
fout_CopyRange:
MsgBox "Error, check parameters !", vbInformation, "Fout"
     Next cl
  End If
End With
End Sub

 

[AD1957]

Controleer de macro eens goed.
waarom zou je dit willen kopieren.

sh.Range("f36:l36").Copy

en:

MsgBox r

 

[rogersmeets]

[COLOR=#3E3E3E]sh.Range("f36:l36").Copy[/COLOR]

Dit zijn de getallen die gekopieerd moeten worden naar het tabblad "Jaarproductie aantal karren", dat klopt toch ?


weet jij de oplossing hoe ik ook de waarden van "F37:L37 (de m3) naar het 3e tabblad gekopieerd krijg met dezelfde macro ?

 

[AD1957]

Toch maar eens goed kijken:

Sub Button2_Click()
Set sh = Sheets("Teamleider-Productie Dashboard")
With Sheets("Jaarproductie-aantal karren")
  r = Application.Match(sh.Range("e37"), .Columns(2), 0)
  If IsNumeric(r) Then
         .Cells(r, 3).Resize(, 7).Value = sh.Range("f37:l37").Value
         
         For Each cl In .Cells(r, 3).Resize(, 7)
           cl.Interior.ColorIndex = sh.Range("f37").Offset(, y).DisplayFormat.Interior.ColorIndex
            y = y + 1
         Next cl
    
        MsgBox "Data gekopieerd naar aantal karren !", vbInformation, "Copy"
  
  End If

End With

With Sheets("Jaarproductie-aantal m3)")
  r = Application.Match(sh.Range("e37"), .Columns(2), 0)
  If IsNumeric(r) Then
         .Cells(r, 3).Resize(, 7).Value = sh.Range("f38:l38").Value
         
         For Each cl In .Cells(r, 3).Resize(, 7)
           cl.Interior.ColorIndex = sh.Range("f38").Offset(, y).DisplayFormat.Interior.ColorIndex
            y = y + 1
         Next cl
    
        MsgBox "Data gekopieerd naar aantal m3!", vbInformation, "Copy"
  
  End If

End With
End Sub

 

[rogersmeets]

36 moet 37 zijn super bedankt voor de oplettendheid en de nieuwe aanpassing :love: