Copy & Paste worksheet into a workbook

[Jones54]

I currently have a series of worksheets which contain production data by shift (AM, PM & Nights, so 3 separate sheets per day). At the end of the week these are copied & pasted into a separate work book. What I want to do is just click on a button in the work book which copy's & pastes the currently open worksheet. I have the following which I came about by recording a macro:


Sub Macro1()
'
' Macro1 Macro
'

'
Windows("2021 01-07 AM.xlsx").Activate
ActiveWindow.SmallScroll Down:=-12
Range("A3:J34").Select
Selection.Copy
Windows("Wk 48 28-11-2021 to 30-11-2021.xlsx").Activate
Range("A6:A7").Select
ActiveSheet.Paste
End Sub

I know this will work for one sheet (2021 01-07AM.xlsx) but then won't work for any other sheets. The 1st range is fine as this will be the same for every sheet. The 2nd range, again I know won't work as I will need to paste into the next available row each time a new worksheet is opened, eg data from the worksheet 2021 01-07PM.xlsx will need to go underneath the data from the worksheet 2021 01-07AM.xlsx and so on.

 

[johnnyL]

@mumps I get an error 91 on the 'LastRow = ...' line when testing your code.

 

[mumps]

What is the error message?

 

[johnnyL]

 

[Zot]

I don't see any problem with @mumps code. However, you need to note that the code copy range is from A1 to last occupied row and column which may have caused the problem.

I can see from you original code you were copying from A3 to J34. Basically you want to copy from A3 to J & last occupied row. Then the paste destination is pivoted at A6(? ... you selected A6 and A7)
So, the modification to the code should be

Sub CopyData()
    Application.ScreenUpdating = False
    Dim LastRow As Long, wb As Workbook
    Dim desWS As Worksheet
    Set desWS = ThisWorkbook.Sheets(1)
    For Each wb In Workbooks
        If wb.Name <> ThisWorkbook.Name Then
            With wb.Sheets(1)
                LastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
'                lcol = .Cells(1, .Columns.Count).End(xlToLeft).Column
                LastDestRow = desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Row
                If LastDestRow < 7 Then
                    .Range(.Cells(3, 1), .Cells(LastRow, "J")).Copy desWS.Cells(7, "A")
                Else
                    .Range(.Cells(3, 1), .Cells(LastRow, "J")).Copy desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1)
                End If
            End With
        End If
    Next wb
    Application.ScreenUpdating = True
End Sub

I remark lcol since the last column is fixed at J. If last column is dynamic, then lcol code is to be used.

My code was with workbook closed but will not work either because I was thinking the AM, PM and Night was in the same workbook but separate sheets ?

 

[Jones54]

Thanks everybody for sharing your knowledge. Zot I have tried the code but still get the same error as I did before "Microsoft Visual Basic for Applications, with a Red Stop symbol with the code 400" when I run the macro. Just to confirm I had the worksheets for the AM, PM & Nights all open, along with the workbook "wk 48 28-11-2021 t.o 30-11-2021".