XL 2019 Export vers GoogleSheet

[Flnte]

Bonjour,

Voila je cherche à pouvoir exporter des données de mon fichier excel vers un document Google Sheet qui est sur mon Google Drive. J'ai mis en partage ce document avec tous les utilisateurs qui ont le lien (y compris pour l'écriture). J'ai cherché à faire une macro pour cela mais je bute en touche....
Dans mon exemple je veux sélectionner les données de la feuille Granit de mon fichier excel de A2 jusqu'à la dernière ligne de la colonne pour ensuite les copier vers Google Sheet (dont le dlien est : https://docs.google.com/spreadsheets/d/1FVThn8ZnIG0huueMG2Hm9pjLbuT2GZ1U/edit#gid=811679162) en cellule A2.

Est-ce que quelqu'un sais comment je dois m'y prendre

j'ai essayé ceci :

Sub CopierVersGoogleSheet()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim rangeToCopy As Range
    Dim googleSheetURL As String
    Dim http As Object
    Dim postData As String
    
    ' Lien vers le Google Sheet
    googleSheetURL = "https://docs.google.com/spreadsheets/d/1FVThn8ZnIG0huueMG2Hm9pjLbuT2GZ1U/edit#gid=811679162"
    
    ' Ouvrir le fichier Excel
    Set wb = ThisWorkbook
    
    ' Définir la feuille "Granit"
    Set ws = wb.Sheets("Granit")
    
    ' Trouver la dernière ligne remplie dans la colonne A
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).row
    
    ' Définir la plage à copier
    Set rangeToCopy = ws.Range("A2:A" & lastRow)
    
    ' Copier la plage dans le Presse-papiers
    rangeToCopy.Copy
    
    ' Créer une instance de l'objet XMLHTTP
    Set http = CreateObject("MSXML2.XMLHTTP")
    
    ' Préparer les données à envoyer
    postData = "{""values"": [[" & Join(Application.Transpose(rangeToCopy.Value), ",") & "]]}"

    
    ' Envoyer les données à Google Sheets
    http.Open "PUT", googleSheetURL & "/values/A2:append?valueInputOption=USER_ENTERED", False
    http.setRequestHeader "Content-Type", "application/json"
    http.send postData
    
    ' Nettoyer
    Set http = Nothing
End Sub

mais il ne se passe rien

 

[job75]

Bonsoir Flnte,

On peut exécuter :

Sub Copier()
ActiveSheet.ListObjects(1).Range.Copy
CreateObject("WScript.Shell").SendKeys "^v"
ThisWorkbook.FollowHyperlink "https://docs.google.com/spreadsheets/d/1FVThn8ZnIG0huueMG2Hm9pjLbuT2GZ1U/edit#gid=811679162"
End Sub

A+

 

[Flnte]

Bonsoir Flnte,

On peut exécuter :

Sub Copier()
ActiveSheet.ListObjects(1).Range.Copy
CreateObject("WScript.Shell").SendKeys "^v"
ThisWorkbook.FollowHyperlink "https://docs.google.com/spreadsheets/d/1FVThn8ZnIG0huueMG2Hm9pjLbuT2GZ1U/edit#gid=811679162"
End Sub

A+

j'ai essayé mais cela ne fonctionne pas. cela ne recopie pas

 

[job75]

Essayez avec une temporisation de 3 secondes :

Sub Copier()
ActiveSheet.ListObjects(1).Range.Copy
ThisWorkbook.FollowHyperlink "https://docs.google.com/spreadsheets/d/1FVThn8ZnIG0huueMG2Hm9pjLbuT2GZ1U/edit#gid=811679162"
Application.Wait Now + 3 / 86400 'temporisation de 3 secondes
CreateObject("WScript.Shell").SendKeys "^v"
End Sub