Macro voor duplicatie van gelinkte sheets en synchronisatie met sharepoint

Status
Niet open voor verdere reacties.

shkipper

Gebruiker
Lid geworden
23 okt 2011
Berichten
12
Hello

Dus wat ik wil is, is dat een lijst die ik aangemaakt heb en gesyncroniseerd met sharepoint list bij het opslaan automatisch gedupliceerd in 2 andere sheets en nadien gesyncroniseerd met sharepoint lists.

Dus wat ik heb is een excel document, met 3 exact gelijke tabbladen(sheets). En als ik ene aanpas moet de aanpassing ook bij het andere gebeuren, maar dat aanpassing bij andere tabbladen kan gebeuren op moment van het opslaan.

De probleem momenteel is, is dat some de duplicatie gebeurt verkeerd, soms .. ikweet niet echt hoe maar some creert hij nieuwe lege rijen bij andere tabbladen ezv en na sychronisatie zie ik in sharepoint extra lege rijen ook.

Ook wat is niet goed, is dat ik de rij niet zomaar kan verwijderen bij gelinkte lijst, ik weet niet waarom, ik probeerde van alles zoals activecell.entirerow.delete of rows(i).enterierow.delete etc etc, maar ik kan rij niet verwijderen. (Ik heb id veld dat uniek is)
Dus stel voor bij ene tabblad ga ik 1 rij verwijderen, maar wat ik ga dan doen is, ik kopieer alle rijen en kolommen (geed headings) en dan selecteer ik de range bij andere tabblad en ga ik dan pasten, MAAR, de extra rijen blijven staan, dus ik moet een manier vinden om zij te verwijderen, want in ene vb heb ik 10 rijeen en bij andere (waar ik naartoe kopieer 12) die 2 rijen worden niet verwijderd, maar de andere 10 wel aangepast.

Code:
Public Sub Duplicate()

Dim activeSheet As Worksheet
Dim s As Worksheet

Set activeSheet = ThisWorkbook.activeSheet
        
Dim RowCount As Integer
Dim CollCount As Integer
Dim name As String


RowCount = activeSheet.UsedRange.rows.Count
CollCount = activeSheet.UsedRange.columns.Count
name = activeSheet.name

        Range(Cells(2, 2), Cells(RowCount, CollCount)).Select
        Selection.Copy

For Each s In ThisWorkbook.Worksheets
    'If s.Name <> activeSheet.Name Then
    '/Sheets(activeSheet).Select
    If s.name <> name Then
        Sheets(s.name).Select
        Range(Cells(2, 2), Cells(RowCount, CollCount)).Select
        Selection.PasteSpecial (xlPasteAll)

    End If
    Next s


    

End Sub

Sub Synchronization()

Dim CellIsATable As Boolean
Dim s As Worksheet
    
For Each s In ThisWorkbook.Worksheets
    s.Activate
    s.Cells(1, 1).Select
    CellIsATable = (Selection.ListObject.name <> "")
    
    If (CellIsATable = True) Then
        Selection.ListObject.UpdateChanges
    Else
        MsgBox "The selected cell is not a part of the list"
    End If
Next s

End Sub

De hulp zou ik echt apprecieren.
Bedankt
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan