transfering data from 2 wbook

[sal21]

I have 2 Wbook LISTA_2005 and LISTA_2004.
Into all 2 Wbook are present many sheets named with the alphabetical
letter A, B, C.... ecc.

All sheets A, B, C ... ecc, contain the first 2 line with header (range
A to V).

From the 3th line are present many value from range A to V.

I would want to transfer the data sheets from LISTA_2004 to data sheets
LISTA_2005 in this mode:

All line (A3 to V....) from the sheet named A into LISTA_2004 into
LISTA_2005 into shest A
All line (A3 to V....) from the sheet named B into LISTA_2004 into
LISTA_2005 into shest B
ecc...

Naturally if into destination sheets are present already a value add
into bottom of this the source line from LISTA_2005...

 

[Tom Ogilvy]

Assume both workbooks are open.

Sub copydata()
Dim bk1 As Workbook, bk2 As Workbook
Dim sh As Worksheet, sh1 As Worksheet
Dim lastrow As Long
Dim destcell As Range
Set bk1 = Workbooks("LISTA_2004")
Set bk2 = Workbooks("LISTA_2005")
For Each sh In bk1.Worksheets
Set sh1 = Nothing
On Error Resume Next
Set sh1 = bk2.Worksheets(sh.Name)
On Error GoTo 0
If sh1 Is Nothing Then
Set sh1 = bk2.Worksheets.Add(After:= _
bk2.Worksheets(bk2.Worksheets.Count))
sh1.Name = sh.Name
sh.UsedRange.Copy Destination:=sh1.Range("A1")
Else
lastrow = sh.Cells(Rows.Count, 1).End(xlUp).Row + 1
destcell = sh1.Cells(Rows.Count, 1).End(xlUp)(1)
sh.Range(sh.Cells(3, 1), sh.Cells(lastrow, "V")).Copy _
Destination:=destcell
End If
Next
End Sub


Untested, but this should be very close.

 

[sal21]

Error 91
Variable or object or block not def...in line:
destcell = sh1.Cells(Rows.Count, 1).End(xlUp)(1)

 

[Tom Ogilvy]

Sub copydata()
Dim bk1 As Workbook, bk2 As Workbook
Dim sh As Worksheet, sh1 As Worksheet
Dim lastrow As Long
Dim destcell As Range
Set bk1 = Workbooks("LISTA_2004")
Set bk2 = Workbooks("LISTA_2005")
For Each sh In bk1.Worksheets
Set sh1 = Nothing
On Error Resume Next
Set sh1 = bk2.Worksheets(sh.Name)
On Error GoTo 0
If sh1 Is Nothing Then
Set sh1 = bk2.Worksheets.Add(After:= _
bk2.Worksheets(bk2.Worksheets.Count))
sh1.Name = sh.Name
sh.UsedRange.Copy Destination:=sh1.Range("A1")
Else
lastrow = sh.Cells(Rows.Count, 1).End(xlUp).Row + 1
set destcell = sh1.Cells(Rows.Count, 1).End(xlUp)(1)
sh.Range(sh.Cells(3, 1), sh.Cells(lastrow, "V")).Copy _
Destination:=destcell
End If
Next
End Sub

 

[sal21]

Tom, your code work perfect! Tks.
PIzza for you.(i live in Napoli - Italy)

A little modify...
Into column G of each sheet (LISTA_204 and LISTA_2005) is prsent a
unique id identify with a number.
Well, if a line (identifyed with ID of column G) of sheet A into
LISTA_2004 is alreday present into sheet A of LISTA_2005 not transfer
thi line and aborate the nex line...ecc...

In this mode i can controll if a user run, for error, the same macro an
make a dupes of line...
Sorry for my english but i hope you have understand me..

 

[Tom Ogilvy]

I caste testID as String. If it is a number, caste/dim it as Long

Sub copydata()
Dim bk1 As Workbook, bk2 As Workbook
Dim sh As Worksheet, sh1 As Worksheet
Dim lastrow As Long
Dim destcell As Range
Dim testId as String, res as Variant
Set bk1 = Workbooks("LISTA_2004")
Set bk2 = Workbooks("LISTA_2005")
For Each sh In bk1.Worksheets
Set sh1 = Nothing
On Error Resume Next
Set sh1 = bk2.Worksheets(sh.Name)
On Error GoTo 0
If sh1 Is Nothing Then
Set sh1 = bk2.Worksheets.Add(After:= _
bk2.Worksheets(bk2.Worksheets.Count))
sh1.Name = sh.Name
sh.UsedRange.Copy Destination:=sh1.Range("A1")
Else
lastrow = sh.Cells(Rows.Count, 1).End(xlUp).Row + 1
testId = sh.Cells(lastrow - 1,"G").Value
set destcell = sh1.Cells(Rows.Count, 1).End(xlUp)(1)
if sh.index = 1 then
res = Application.Match(testId,sh1.Columns(7),0)
if not iserror(res) then
msgbox "This macro has already been run - quitting . . . "
exit sub
End if
End if
sh.Range(sh.Cells(3, 1), sh.Cells(lastrow, "V")).Copy _
Destination:=destcell
End If
Next
End Sub

 

[sal21 sal21]

Hi Tom, sorry for delay..
You code work fine!

Note: i have adjust this line
from
Set bk1 = Workbooks("LISTA_2004")
Set bk2 = Workbooks("LISTA_2005")
to
Set bk1 = Workbooks("LISTA_2004.xls")
Set bk2 = Workbooks("LISTA_2005.xls")
is correct?



*** Sent via Developersdex http://www.developersdex.com ***

 

[Tom Ogilvy]

Yes,
I almost always put in the .xls, but I noticed I overlooked adding it a
couple of times this weekend. Based on some settings, not using it will
work, but not always. Including the .xls will always worked and is
recommended.

Sorry for the oversight.

 

[sal21 sal21]

Dont worry, an d naturally, tks
You are the teacher and i the student, for teacher all is permit!;-)
Sal.

*** Sent via Developersdex http://www.developersdex.com ***