Copier/Coller plage d'un fichier à un autre
Bonjour au forum,
Je souhaite copier la plage de B2 jusqu'à dernière cellule non vide à J2 jusqu'à dernière cellule non vide d'un fichier A puis les coller (valeurs uniquement) à partir de la première ligne vide, dans les colonnes de A à I dans un second fichier B.
J'ai testé ceci mais je n'ai que la première ligne de collée, je n'arrive pas à comprendre mon erreur...
Sub Copy()
Dim Plage As Range
Dim dl As Long, dl2 As Long
dl = Sheets("Import").Range("A" & Rows.Count).End(xlUp).Row + 1
dl2 = Sheets("Import").Range("I" & Rows.Count).End(xlUp).Row + 1
If MsgBox("Voulez-vous réellement importer des données de donneurs ?", vbExclamation + vbYesNo, "Importer ?") = vbNo Then
Exit Sub
Else:
Application.ScreenUpdating = False
ChDrive "O"
ChDir "chemin"
With Sheets("Import")
Set Plage = .Range("A" & dl & ":I" & dl)
.Unprotect "mdp"
End With
With Workbooks.Open(Application.GetOpenFilename)
Plage.Value = .Worksheets(1).Range("B2:J4000").Value
.Close False
End With
Plage.Worksheet.Protect "mdp", True, True, False, AllowFormattingCells:=True, _
AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
End If
Application.ScreenUpdating = True
End Sub
Auriez-vous une petite idée ?
PS : le fichier d'origine contenant énormément de données sensibles, je tente sans envoyer un fichier exemple, même si je sais que ce n'est pas une bonne idée... Mais si cela est indispensable, j'essayerais de faire au mieux
Merci d'avance !
Bonsoir Nrev74
essaie peut-être de cette façon ??
Sub Copy()
Dim Plage As Range
Dim dl As Long, dl2 As Long
dl = Sheets("Import").Range("A" & Rows.Count).End(xlUp).Row + 1
dl2 = Sheets("Import").Range("I" & Rows.Count).End(xlUp).Row + 1
If MsgBox("Voulez-vous réellement importer des données de donneurs ?", vbExclamation + vbYesNo, "Importer ?") = vbNo Then
Exit Sub
Else:
Application.ScreenUpdating = False
ChDrive "O"
ChDir "chemin"
With Sheets("Import")
Set Plage = .Range("A" & dl & ":I" & dl2)
.Unprotect "mdp"
End With
With Workbooks.Open(Application.GetOpenFilename)
.Worksheets(1).Range("B2:J4000").Value = Plage.Value
.Save
.Close False
End With
Plage.Worksheet.Protect "mdp", True, True, False, AllowFormattingCells:=True, _
AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
End If
Application.ScreenUpdating = True
End Sub
Bonne soirée
Bonjour Patty5046,
Merci pour ta réponse, malheureusement, rien n'est importé avec le code proposé...
Je vais joindre un fichier exemple pour plus de facilité.
Merci énormément pour l'aide !
Re,
Je crois m'en être sorti de cette manière :
Sub Copy()
Dim dl1 As Long, dl2 As Long
Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
On Error GoTo Erreur
ChDrive "C"
ChDir "C:\Users\nico\Desktop\cts"
Set wb1 = ThisWorkbook
Set ws1 = wb1.Sheets("Import")
Set wb2 = Workbooks.Open(Application.GetOpenFilename)
Set ws2 = wb2.Worksheets(1)
dl1 = ws1.Range("A" & Rows.Count).End(xlUp).Row + 1
dl2 = ws2.Range("A" & Rows.Count).End(xlUp).Row
If MsgBox("Voulez-vous réellement importer des données de donneurs ?", vbExclamation + vbYesNo, "Importer ?") = vbNo Then
Exit Sub
Else:
Application.ScreenUpdating = False
ws1.Unprotect ""
ws2.Range("B2:J" & dl2).Copy
ws1.Range("A" & dl1).PasteSpecial Paste:=xlPasteValues
wb2.Close False
ws1.Protect "", True, True, False, AllowFormattingCells:=True, _
AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
End If
Application.ScreenUpdating = True
Exit Sub 'Permet de sortir de la procédure et évite la gestion d'erreur (Erreur), si la macro
's'est déroulée sans encombre.
Erreur:
MsgBox "Aucun fichier sélectionné !", vbExclamation, "Annulation !"
End Sub
Maintenant je galère pour une chose... :
- j'aimerais mettre des bordures épaisses sur le coté gauche, droit et en bas, une medium sur celle du haut et des fines à l'intérieure dans la feuille de destination ("Import"), et que cela se mette à jour à chaque importation
Si vous avez un idée...
Merci !
Maintenant je galère pour une chose... :
- j'aimerais mettre des bordures épaisses sur le coté gauche, droit et en bas, une medium sur celle du haut et des fines à l'intérieure dans la feuille de destination ("Import"), et que cela se mette à jour à chaque importation
Si vous avez un idée...
Je m'en suis finalement sorti également...
Pour ceux que ça pourrait intéresser :
With ws1
dl3 = ws1.Range("A" & Rows.Count).End(xlUp).Row
.Range("A11:I" & dl3).Borders.Value = 1
.Range("A11:I" & dl3).Borders(xlEdgeLeft).Weight = xlThick
.Range("A11:I" & dl3).Borders(xlEdgeRight).Weight = xlThick
.Range("A11:I" & dl3).Borders(xlEdgeTop).Weight = xlMedium
.Range("A11:I" & dl3).Borders(xlEdgeBottom).Weight = xlThick
.Range("A11:I" & dl3).Locked = True
.Protect "", True, True, False, AllowFormattingCells:=True, _
AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
End With