PDA

View Full Version : Copy cells from an open workbook to a closed workbook



michandbe
04-09-2014, 12:15 AM
Good day all! I am trying to post entries from an active sheet of a three sheet workbook to a closed workbook. Herewith below is the code that I am trying to use. can anybody help me cause it gives me an error 424 in Ln41. To be honest, i have posted this query in other forums, but still came out stomped. My apologies for such. Below is the code.


Sub Macro8()
'
' Macro8 Macro
'
' Keyboard Shortcut: Ctrl+Shift+W
'
Dim FileName
Dim Stock As String
Dim RefenceQty As String


Sheets("Movement").Range("D1048576").End(xlUp).Copy
Sheets("Movement").Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
FileName = ThisWorkbook.Path & "\Stock Cards\" & ThisWorkbook.Worksheets(1).Cells(1, 1).Value & ".xlsx"
Stock = ThisWorkbook.Worksheets(2).Cells(1, 1).Value
Application.CutCopyMode = False


Dim BaseRange1a As Range
Dim BaseRange2a As Range
Dim BaseRange3a As Range
Dim BaseRange4a As Range
Dim BaseRange5a As Range
Dim BaseRange6a As Range
Dim BaseRange7a As Range
Dim BaseRange8a As Range
Dim BaseRange9a As Range

Set BaseRange1a = ThisWorkbook.Worksheets("Movement").Range("A1048576").End(xlUp)
Set BaseRange2a = ThisWorkbook.Worksheets("Movement").Range("B1048576").End(xlUp)
Set BaseRange3a = ThisWorkbook.Worksheets("Movement").Range("C1048576").End(xlUp)
Set BaseRange4a = ThisWorkbook.Worksheets("Movement").Range("D1048576").End(xlUp)
Set BaseRange5a = ThisWorkbook.Worksheets("Movement").Range("E1048576").End(xlUp)
Set BaseRange6a = ThisWorkbook.Worksheets("Movement").Range("F1048576").End(xlUp)
Set BaseRange7a = ThisWorkbook.Worksheets("Movement").Range("G1048576").End(xlUp)
Set BaseRange8a = ThisWorkbook.Worksheets("Movement").Range("H1048576").End(xlUp)
Set BaseRange9a = ThisWorkbook.Worksheets("Movement").Range("I1048576").End(xlUp)

Workbooks.Open FileName

With FileName

.Range("A1048576").End(xlUp).Offset(1, 0) = BaseRange1a
.Range("A1048576").End(xlUp).Offset(1, 1) = BaseRange2a
.Range("A1048576").End(xlUp).Offset(1, 2) = BaseRange3a
.Range("A1048576").End(xlUp).Offset(1, 5) = BaseRange4a
.Range("A1048576").End(xlUp).Offset(1, 6) = BaseRange5a

End With

ActiveWorkbook.Save
ActiveWorkbook.Close




End Sub


Hoping for your assistance in such.


Mike

mancubus
04-09-2014, 12:41 AM
hi and welcome to the forum.

please provide links to the threads in other forums. until you reach 5 posts in the forum, you can use http// www abcd.com thread.htm format for this.



Sub Macro8()

Dim ws As Worksheet, LastCell As Range
Dim FileName
Dim Stock As String
Dim RefenceQty As String

Set ws = ThisWorkbook.Worksheets("Movement")

ws.Range("A1").Value = ws.Range("D" & Rows.Count).End(xlUp).Value
FileName = ThisWorkbook.Path & "\Stock Cards\" & ThisWorkbook.Worksheets(1).Cells(1, 1).Value & ".xlsx"
Stock = ThisWorkbook.Worksheets(2).Cells(1, 1).Value

Workbooks.Open FileName

With Workbooks(FileName) 'or "With ActiveWorkBook" since the last opened workbook is the active wb.
With .ActiveSheet.Range("A" & Rows.Count).End(xlUp)
.Offset(1, 0).Value = ws.Range("A" & Rows.Count).End(xlUp).Value
.Offset(1, 1).Value = ws.Range("B" & Rows.Count).End(xlUp).Value
.Offset(1, 2).Value = ws.Range("C" & Rows.Count).End(xlUp).Value
.Offset(1, 5).Value = ws.Range("D" & Rows.Count).End(xlUp).Value
.Offset(1, 6).Value = ws.Range("E" & Rows.Count).End(xlUp).Value
'...
'...
'...
End With
.Save
.Close
End With

End Sub