XL 2019 Export vers GoogleSheet

Flnte

XLDnaute Junior
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 :
VB:
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
 

Pièces jointes

  • ClasseurExportGS.xlsm
    16.9 KB · Affichages: 3

job75

XLDnaute Barbatruc
Bonsoir Flnte,

On peut exécuter :
VB:
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+
 

job75

XLDnaute Barbatruc
Essayez avec une temporisation de 3 secondes :
VB:
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
 

Statistiques des forums

Discussions
313 283
Messages
2 096 811
Membres
106 751
dernier inscrit
Souleymani