XL 2013 Copier coller d'une feuille vers une autre feuille

fanch55 à dit:

Bonjour,
Code à mettre dans un module de FF.xlsx
Vérifiez Target
Exécutez CopyToBase

VB:

Option Explicit
Sub CopyToBase()
Dim FromSh As Worksheet, ToSh As Worksheet
Dim Cell    As Range
Dim FromName As String, Target As String, Address As String
Dim C       As Integer

    Target = ThisWorkbook.Path & "\" & "Base.xlsx"
   
    Set ToSh = OpenWs(Target, "Feuil1")
    If Not ToSh Is Nothing Then
        FromName = CreateObject("Scripting.FileSystemObject").GetBaseName(ThisWorkbook.Name)
        Set FromSh = ThisWorkbook.Worksheets("Feuil1")
        For C = 1 To 3
            Set Cell = FromSh.Columns(C).Find("*")
            If Not Cell Is Nothing Then
                Address = Cell.Address
                Do: Cell.Copy
                    ToSh.Cells(Cell.Row, Cell.Column).PasteSpecial xlPasteValues
                    ToSh.Cells(Cell.Row, "D") = FromName
                    Set Cell = FromSh.Columns(C).FindNext(Cell)
                Loop Until Address = Cell.Address
            End If
        Next
    End If
End Sub
Function OpenWs(Classeur As String, Feuille As String) As Worksheet
    On Error Resume Next
    Set OpenWs = Workbooks(Classeur).Worksheets(Feuille)
    If Err Then Set OpenWs = Workbooks.Open(Classeur).Worksheets(Feuille)
End Function

Cliquez pour agrandir...

SAMESS à dit:

Merci fanch55,
si j'ai changé les colonnes en principe le code sera changé non ?

Cliquez pour agrandir...