Import web, copier jusqu'à x puis coller
Résolu
Leghe59
Messages postés
34
Date d'inscription
Statut
Membre
Dernière intervention
-
Leghe59 Messages postés 34 Date d'inscription Statut Membre Dernière intervention - 25 sept. 2020 à 18:13
Leghe59 Messages postés 34 Date d'inscription Statut Membre Dernière intervention - 25 sept. 2020 à 18:13
A voir également:
- Import web, copier jusqu'à x puis coller
- Web office - Guide
- Historique copier-coller android - Guide
- Copier coller pdf - Guide
- Copier-coller - Accueil - Informatique
- Style d'écriture a copier coller - Guide
3 réponses
Bonjour,
voici un code à adapter:
voici un code à adapter:
Option Explicit Sub copier() Dim i As Integer For i = 1 To 12 ' a adapter Worksheets("Feuil2").Range("A1") = Worksheets("Feuil2").Range("A1") & Worksheets("Feuil1").Range("A" & i) & Chr(13) & Chr(10)' a la ligne sinon virgule ", " Next End Sub
Merci, mais je ne connais pas i à l'avance.
En fait, en feuille TEMP, ce dont j'ai besoin se trouve sous "Résumé", d'où le
mais fait parfois 2, 3, voire x lignes, jusqu'à "Caractéristiques" comme dans le fichier déposé sur cjoint.
En fait, en feuille TEMP, ce dont j'ai besoin se trouve sous "Résumé", d'où le
Sheets("TEMP").Cells(Lig + 1, 1).Value
mais fait parfois 2, 3, voire x lignes, jusqu'à "Caractéristiques" comme dans le fichier déposé sur cjoint.
Il faut faire une recherche des mots comme ceci:
Si problème le classeur est disponible. Il suffit de demander!
@+ Le Pivert
Option Explicit 'déclaration des variables : Dim debut As Integer Dim fin As Integer Dim Derlig As Long Dim compteur As Integer Dim Col_A, SYNOP, CARAC, Lig Dim i As Integer Sub IMPORTDECITRE() Dim ISBN As String Derlig = Sheets("EXPORT").Range("A" & Rows.Count).End(xlUp).Row For compteur = 2 To 2 ISBN = Sheets("EXPORT").Cells(compteur, 1) Sheets("TEMP").Cells.Clear Application.CutCopyMode = False With Sheets("TEMP").QueryTables.Add(Connection:="URL;https://www.decitre.fr/rechercher/result?q=" & ISBN _ , Destination:=Sheets("TEMP").Range("$A$1")) .Name = ISBN .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = False .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .WebSelectionType = xlEntirePage .WebFormatting = xlWebFormattingAll .WebPreFormattedTextToColumns = True .WebConsecutiveDelimitersAsOne = True .WebSingleBlockTextImport = False .WebDisableDateRecognition = False .WebDisableRedirections = False .Refresh BackgroundQuery:=False End With With Sheets("TEMP") Set Col_A = .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row) SYNOP = Application.CountIf(Col_A, "*Résumé*") CARAC = Application.CountIf(Col_A, "*Caract*") If SYNOP > 0 Then Lig = 1 Lig = .Columns("A").Find("Résumé", .Cells(Lig, "A"), , xlPart).Row debut = Lig + 1 Lig = .Columns("A").Find("Caractéristiques", .Cells(Lig, "A"), , xlPart).Row fin = Lig - 1 Sheets("EXPORT").Cells(compteur, 7).Interior.ColorIndex = 4 Else Sheets("EXPORT").Cells(compteur, 7) = "inconnu" Sheets("EXPORT").Cells(compteur, 7).Interior.ColorIndex = 3 End If End With Next For i = debut To fin Sheets("EXPORT").Range("G" & Derlig) = Sheets("EXPORT").Range("G" & Derlig) & Sheets("TEMP").Range("A" & i) & Chr(13) & Chr(10) ' a la ligne sinon virgule ", " Next Sheets("EXPORT").Activate End Sub
Si problème le classeur est disponible. Il suffit de demander!
@+ Le Pivert