Kopiëren van een tabel naar een werkboek met variabele naam, onder bestaande lijnen

[COLOR="Navy"]Sub databasing()


Dim sDatabasename As String



sDatabasename = "c:\mijn documenten\" & Range("'Direct Mail tool'!G17") & Format(Now(), "yy") & ".xls"




Workbooks("SPOT V3").Worksheets("summary direct mail").Activate

ActiveSheet.Range("A12").CurrentRegion.Select

Selection.Copy


Workbooks.Open Filename:=sDatabasename


ActiveSheet.Range("A1").CurrentRegion.Select

ActiveCell.Offset(1, 0).Select


[B]Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False[/B]
        
Workbooks("sDatabasename.Name").Close



  ActiveWorkbook.Protect Password:="pricing", _
Structure:=True, Windows:=True
End Sub[/COLOR]

Sub databasing()

    Dim sDatabasename As String
    Dim wb As Workbook

    sDatabasename = "c:\mijn documenten\" & Sheets("Direct Mail tool").Range("G17").Value & Format(Now(), "yy") & ".xls"

    With Workbooks("SPOT V3")
    
        .Worksheets("summary direct mail").Range("A12").CurrentRegion.Copy
    
        On Error Resume Next
        Set wb = Workbooks.Open(Filename:=sDatabasename)
        On Error GoTo 0
        
        If Not wb Is Nothing Then
        
            wb.Sheets("[B][U]NAAMVANDESHEET[/U][/B]").Range("A2").PasteSpecial xlValues
            
            Application.CutCopyMode = False
            
            wb.Close True
        
        End If
        
        .Protect Password:="pricing", Structure:=True, Windows:=True
        
        Set wb = Nothing
    
    End With
    
End Sub

Function xlLastRow(Optional WorksheetName As String) As Long
     
     '    find the last populated row in a  worksheet
     
    If WorksheetName = vbNullString Then
        WorksheetName = ActiveSheet.Name
    End If
    With Worksheets(WorksheetName)
        xlLastRow = .Cells.Find("*", .Cells(1), xlFormulas, _
        xlWhole, xlByRows, xlPrevious).Row
    End With
     
    End Function
    
    Sub databasing()


    Dim sDatabasename As String
    Dim wb As Workbook

    sDatabasename = "c:\mijn documenten\" & Sheets("Direct Mail tool").Range("G17").Value & Format(Now(), "yy") & ".xls"



    
    With Workbooks("SPOT V3")
    
        .Worksheets("summary direct mail").Range("A12").CurrentRegion.Copy
    
        On Error Resume Next
        Set wb = Workbooks.Open(Filename:=sDatabasename)
        On Error GoTo 0
        
        If Not wb Is Nothing Then
        
            wb.Sheets("sheet1").Cells(xlLastRow + 1, 1).PasteSpecial xlValues
            
            Application.CutCopyMode = False
            
            wb.Close True
        
        End If
        
        .Protect Password:="pricing", Structure:=True, Windows:=True
        
        Set wb = Nothing
    
    End With

End Sub

Sub databasing()
  c0=Sheets("Direct Mail tool").Range("G17").Value & Format(Now(), "yy") & ".xls"
  If dir("c:\mijn documenten\" & c0)<>"" then
    Workbooks.open "c:\mijn documenten\" & c0
    With Workbooks("SPOT V3")
      .sheets("summary direct mail").Range("A12").CurrentRegion.Copy
      With Workbooks(c0)
        .Sheets("sheet1").Cells(rows.count,1).end(xlup).offset(1).PasteSpecial xlValues
        .Close True
      End With
      Application.CutCopyMode = False
      .Protect "pricing", True, True
    End With
  End If
 End Sub