Summertime
09-06-2017, 04:53 AM
Hello all,
I am stuck on a problem regarding updating my Excel database.
I have an entry file (WB1) where in one sheet data will be written (WB1.sheet("entry"). This data is copied to another sheet in WB1: WB1.sheet("data"). So I have all data I want in by database already in one row (same format as in database: A2:ZZ2).
Data can be saved in WB2=database.xls. Once row A2:ZZ2 will be pasted in WB2 a new ID is created and all data is saved in table format - so entry is written in next free row.
Now I would like to implement updating the database in WB2=database.xls when the ID is found in WB2=database.xls.
It is already possible to show the entry from WB2 again in WB1.sheet("entry") by entering the ID in one field "K6".
When I make changes in WB1.sheet("entry") I want to overwrite old entry in WB2=database.xls.
ID is in WB2=database.xls(sheet:"DB") in A:A.
So far I have the following but data is not overwritten:
Sub FindenUndKopieren()
Dim wbQuelle As Workbook, wksQuelle As Worksheet
Dim wbZiel As Workbook, wksZiel As Worksheet
Dim rng As Range
Dim ID As String
Set wbQuelle = ActiveWorkbook
Set wksQuelle = wbQuelle.Worksheets("Data")
Application.ScreenUpdating = False
strPfadZiel = "Y:........"
strPfadZiel = wbQuelle.path
strZiel = "Database.xlsx"
ID = wbQuelle.Worksheets("Entry").Range("K6")
If fncCheckWorkbookOpen(strZiel) Then
Set wbZiel = Application.Workbooks(strZiel)
bolOpen = True
Else
Set wbZiel = Application.Workbooks.Open(strPfadZiel & Application.PathSeparator _
& strZiel)
bolOpen = False
End If
Set wksZiel = wbZiel.Worksheets("DB")
Set rng = wksZiel.Range("A:A").Find(ID)
If rng Is Nothing Then
MsgBox "ID " & ID & " nicht gefunden!"
Else
wksQuelle.Range("A2:zz2").Copy
wksZiel.Select
rng.Select
ActiveSheet.Paste
Application.CutCopyMode = False
End If
End Sub
Can someone please help me?
I am stuck on a problem regarding updating my Excel database.
I have an entry file (WB1) where in one sheet data will be written (WB1.sheet("entry"). This data is copied to another sheet in WB1: WB1.sheet("data"). So I have all data I want in by database already in one row (same format as in database: A2:ZZ2).
Data can be saved in WB2=database.xls. Once row A2:ZZ2 will be pasted in WB2 a new ID is created and all data is saved in table format - so entry is written in next free row.
Now I would like to implement updating the database in WB2=database.xls when the ID is found in WB2=database.xls.
It is already possible to show the entry from WB2 again in WB1.sheet("entry") by entering the ID in one field "K6".
When I make changes in WB1.sheet("entry") I want to overwrite old entry in WB2=database.xls.
ID is in WB2=database.xls(sheet:"DB") in A:A.
So far I have the following but data is not overwritten:
Sub FindenUndKopieren()
Dim wbQuelle As Workbook, wksQuelle As Worksheet
Dim wbZiel As Workbook, wksZiel As Worksheet
Dim rng As Range
Dim ID As String
Set wbQuelle = ActiveWorkbook
Set wksQuelle = wbQuelle.Worksheets("Data")
Application.ScreenUpdating = False
strPfadZiel = "Y:........"
strPfadZiel = wbQuelle.path
strZiel = "Database.xlsx"
ID = wbQuelle.Worksheets("Entry").Range("K6")
If fncCheckWorkbookOpen(strZiel) Then
Set wbZiel = Application.Workbooks(strZiel)
bolOpen = True
Else
Set wbZiel = Application.Workbooks.Open(strPfadZiel & Application.PathSeparator _
& strZiel)
bolOpen = False
End If
Set wksZiel = wbZiel.Worksheets("DB")
Set rng = wksZiel.Range("A:A").Find(ID)
If rng Is Nothing Then
MsgBox "ID " & ID & " nicht gefunden!"
Else
wksQuelle.Range("A2:zz2").Copy
wksZiel.Select
rng.Select
ActiveSheet.Paste
Application.CutCopyMode = False
End If
End Sub
Can someone please help me?