Transfert d'un classeur dans un autre

Tranfert des cellules B1,B3,B5,B7 de BDDappel.xls dans Bdd.xls (ouvert)

BDD.zip

Solution1:

Une zone tampon en colonne G contient des formules vers B1,B3,B5,B7:

Sub TransfertBDD()
  [G2:G5].Copy
  Workbooks("bdd.xls").Sheets(1).[A65000].End(xlUp).Offset(1, 0).PasteSpecial _
  Paste:=xlPasteValues, Transpose:=True
End Sub

Solution2:

Sub TransfertBDD2()
   Dim temp(1 To 1, 1 To 4)
   temp(1, 1) = [B1]
   temp(1, 2) = [B3]
   temp(1, 3) = [B5]
   temp(1, 4) = [B7]
   Workbooks("bdd.xls").Sheets(1).[A65000].End(xlUp).Offset(1, 0).Resize(1, 4) = temp
End Sub

Solution2bis (ligne totalement vide dans BDD):

Sub TransfertBDD2bis()
  Dim temp(1 To 1, 1 To 4)
  temp(1, 1) = [B1]
  temp(1, 2) = [B3]
  temp(1, 3) = [B5]
  temp(1, 4) = [B7]
  Set champ = Workbooks("bdd.xls").Sheets(1).[A65000].End(xlUp).Offset(1, 0).Resize(1, 4)
  Do While Application.CountA(champ) > 0 ' ligne totalement vide
    Set champ = champ.Offset(1, 0)
  Loop
  champ.Value = temp
End Sub

Solution3 avec ADO: BDD.XLS fermé

La base de BDD.Xls est nommée MaBDD($A$1:$D$1 au départ)

Sub TransfertBDD3()
   ' Cocher Microsoft ActivexDataObject 2.8 Library (outils/références)
   ChDir ActiveWorkbook.Path
   Set Cnn = New ADODB.Connection
   Cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=BDD.XLS;Extended Properties=Excel 8.0;"
   Sql = "INSERT INTO MaBDD (Civilité,Nom,Ville,Salaire) VALUES('" & [B1] & "','" & [B3] & "','" & _
   [B5] & "'," & [B7] & ")"
   Cnn.Execute Sql
   Cnn.Close
   Set Cnn = Nothing
End Sub