Excel 2003 + export of data
Hi Mike, i'm disappointed in myself for not knowing that one!! Thanks very
much for your help, that is brilliant.
It works perfect now.
Take Care.
Neil.
"Mike H" wrote:
Neil
The mistake you making is closing wb2. here are your first 2 copy/paste
routines
lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM405").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True '< You close here so delete this line
lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ETM409").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues 'The try to read
wb2.Close True
Note you close wb2 and save it then go into you second paste routine and try
and get the last row to get the cell to paste into but because the book is
closed it falls over.
Answer= leave wb2 open until you've finished
Now you also have another issue with this line
lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
For your first paste it will return 1 so data will paste into A1 and your
pasting 20 rows. But on the second paste that same line returns 20 so you
will overwrite the last row of your previous set of data so modify the line
to this
lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row+1
the will prevent overwriting your data and solve the problem over starting
in row 1.
Hope this helps
--
Mike
When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.
"Neil Holden" wrote:
Thanks Mike, I have adapted it to suit all the sheets i need to copy:
However it is throwing an error for lngRow = ws.Cells(Rows.Count,
"A").End(xlUp).Row on the second excel sheet to copy in the code, also the
data it copies to the external sheet its starting on row 1, i need it to
start pasting on row 2?
Sorry to be a pain.
Neil.
Sub Button2_Click()
Dim wb1 As Workbook, wb2 As Workbook
Dim ws As Worksheet, lngRow As Long
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set wb1 = ActiveWorkbook
Set wb2 = Workbooks.Open("\\sguk-app1\Business Objects\CHR\Export of
SGUK.xls")
Set ws = wb2.Sheets("Sheet1")
lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM405").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True
lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ETM409").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True
lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM450").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True
lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM451").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True
lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ESS453").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True
lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM454").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True
lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM479").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True
lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ESH492").Range("A8:U27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True
'lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
'wb1.Sheets("EGEC524").Range("A8:T27").Copy
'ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
'wb2.Close True
lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ECP528").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True
lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ECP532").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True
lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM543").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True
lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("MPC549").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True
lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ECP550").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True
lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM582").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True
lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EGC596").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True
lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("ECP602").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True
lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM605").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True
lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EGC613").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True
lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
wb1.Sheets("EAM632").Range("A8:T27").Copy
ws.Range("A" & lngRow).PasteSpecial Paste:=xlPasteValues
wb2.Close True
wb2.Close True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
|