T
temil
First let me say, I'm a complete vb noob. I know excel very well, but
vb is completely new to me, so please be gentle with me =) .. hehe.
I found this script on here posted back in mid 2008, and for some
reason I couldn't reply to it, so I'm posting a new topic on it to see
if anyone can help me out.
The following code basically takes a specified Range and checks the
first Column of that range, and finds all data to the left without a
set number of cells. It then copies that data to a different workbook,
that part for me works fine, but I'm curious on a few things.
1. is there anyway to copy only values, and not formulas as it's doing
now. I tried adding in Paste Specials but that didn't work.
2. I would like to modify this, to where i can have it copy multiple
cell ranges (example: A1:C10, A3:C10, D1:C12) and make a separate
copied selection area into the new workbook. Is that as simple as
copying the section of code that is referring to the finding of next
blank cell in that row?
3.Is there any simply way to make a macro to work in reverse as well?
Basically, so that i have 1 macro key to backup/save the data. Then
another that will restore the data into the correct field, NOT filling
in blanks though. Only restoring the values IF the 2nd workbook has
that info, if not, then skip it.
Would it help if i posted the document so you can see exactly what i'm
trying to do?
Here is the working code i found on here previously, but doesn't fully
do what i need it to currently...
Thanks again for any help!
Sub Test()
Dim bk As Workbook
Dim bSave As Boolean
Dim lRow As Long
' test to see if Destination.xls is already open
On Error Resume Next
Set bk = Workbooks("Destination.xls")
On Error GoTo 0
If bk Is Nothing Then
bSave = True
Set bk = Workbooks.Open("C:\Destination.xls")
End If
'find first empty row in database
lRow = bk.Worksheets("Test").Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row
With ThisWorkbook.Sheets("Data4")
RowCount = 1
Do While .Range("A" & RowCount) <> ""
FindData = .Range("A" & RowCount)
Set c = bk.Worksheets("Test").Columns("A").Find(what:=FindData, _
LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
.Range("A" & RowCount & ":C" & RowCount).Copy _
Destination:=bk.Worksheets("Test").Range("A" & lRow)
lRow = lRow + 1
Else
.Range("A" & RowCount & ":C" & RowCount).Copy _
Destination:=bk.Worksheets("Test").Range("A" & c.row)
End If
RowCount = RowCount + 1
Loop
End With
' if destination was originally closed, then save and close it
If bSave Then bk.Close Savechanges:=True
End Sub
vb is completely new to me, so please be gentle with me =) .. hehe.
I found this script on here posted back in mid 2008, and for some
reason I couldn't reply to it, so I'm posting a new topic on it to see
if anyone can help me out.
The following code basically takes a specified Range and checks the
first Column of that range, and finds all data to the left without a
set number of cells. It then copies that data to a different workbook,
that part for me works fine, but I'm curious on a few things.
1. is there anyway to copy only values, and not formulas as it's doing
now. I tried adding in Paste Specials but that didn't work.
2. I would like to modify this, to where i can have it copy multiple
cell ranges (example: A1:C10, A3:C10, D1:C12) and make a separate
copied selection area into the new workbook. Is that as simple as
copying the section of code that is referring to the finding of next
blank cell in that row?
3.Is there any simply way to make a macro to work in reverse as well?
Basically, so that i have 1 macro key to backup/save the data. Then
another that will restore the data into the correct field, NOT filling
in blanks though. Only restoring the values IF the 2nd workbook has
that info, if not, then skip it.
Would it help if i posted the document so you can see exactly what i'm
trying to do?
Here is the working code i found on here previously, but doesn't fully
do what i need it to currently...
Thanks again for any help!
Sub Test()
Dim bk As Workbook
Dim bSave As Boolean
Dim lRow As Long
' test to see if Destination.xls is already open
On Error Resume Next
Set bk = Workbooks("Destination.xls")
On Error GoTo 0
If bk Is Nothing Then
bSave = True
Set bk = Workbooks.Open("C:\Destination.xls")
End If
'find first empty row in database
lRow = bk.Worksheets("Test").Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row
With ThisWorkbook.Sheets("Data4")
RowCount = 1
Do While .Range("A" & RowCount) <> ""
FindData = .Range("A" & RowCount)
Set c = bk.Worksheets("Test").Columns("A").Find(what:=FindData, _
LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
.Range("A" & RowCount & ":C" & RowCount).Copy _
Destination:=bk.Worksheets("Test").Range("A" & lRow)
lRow = lRow + 1
Else
.Range("A" & RowCount & ":C" & RowCount).Copy _
Destination:=bk.Worksheets("Test").Range("A" & c.row)
End If
RowCount = RowCount + 1
Loop
End With
' if destination was originally closed, then save and close it
If bSave Then bk.Close Savechanges:=True
End Sub