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]

The following should copy all three (AM/PM/Nights) to the Wk 48 28-11-2021 to 30-11-2021.xlsx:

Sub ShortenedMacro1()
'
    Dim LastRowDestination  As Long
    Dim WB As Workbook
'
    LastRowDestination = 5
'
    For Each WB In Workbooks
        Select Case WB.Name
            Case "2021 01-07 AM.xlsx", "2021 01-07 PM.xlsx", "2021 01-07 Nights.xlsx"
                Windows(WB.Name).Activate
                Range("A3:J34").Copy
'
                Windows("Wk 48 28-11-2021 to 30-11-2021.xlsx").Activate
                Range("A" & LastRowDestination + 1).Select
                ActiveSheet.Paste
'
                LastRowDestination = Range("A" & Rows.Count).End(xlUp).Row              ' Returns a Row Number
        End Select
    Next
'
    Application.CutCopyMode = False
End Sub

 

[Zot]

I have created a macro for your task but not sure if this is something you prefer.

The program is run from a workbook. This will be independent workbook which has nothing to do with your daily workbook and also weekly workbook where you compiled all the daily report. The condition is:
Your daily workbook must have only 3 sheets for AM, PM and night because program will loop all sheets in Daily workbook regardless the name (can be modified to loop specific sheets only)

Here is what the program do:
When you run the program the 1st time, it will ask the Weekly workbook name it will create. You can put any name. If you already have a Weekly workbook created before, then just click OK to selectt he previously created one (follow instruction on InputBox).

Then the program will ask for Daily workbook. Once you select it, it will create sheet Day 1 and copies the AM, PM and Night data to the sheet. The following day (if you select the same Weekly workbook) it will add Day 2 sheet, Day 3, and so on.

The line
Set rngData = ws.Range("A3", ws.Cells(Rows.Count, "J").End(xlUp))
will set the range to copy starting from A3 to last data row in column J

The line
rngData.Copy wsWeekly.Range("A" & nRow)

Will paste the rngData to Weekly workbook at cell A & nRow where nRow= 6 and continue down for all AM, PM and Night data

Create a workbook to put the program macro and paste the code below. Run the CreateNewBook to execute.

Sub CreateNewBook()

Dim wbName As String
Dim OriSheetCount As Long
Dim wb As Workbook, wbWeekly As Workbook

Set wb = ActiveWorkbook

wbName = InputBox("Enter Weekly Report Name" & vbLf & _
                "(Leave Blank and click OK to sellect existing file)", "CREATE NEW WORKBOOK")
If StrPtr(wbName) = 0 Then
    MsgBox ("User Canceled!")
    Exit Sub
ElseIf wbName = vbNullString Then
    CopyData wbWeekly, False
Else
    OriSheetCount = Application.SheetsInNewWorkbook
    Application.SheetsInNewWorkbook = 1
    Set wbWeekly = Workbooks.Add
    NewName = wbPath & wbName
    ActiveWorkbook.SaveAs NewName
    wbWeekly.ActiveSheet.Name = "Day 1"
    Application.SheetsInNewWorkbook = OriSheetCount
    CopyData wbWeekly, True
End If

End Sub

Sub CopyData(wbWeekly As Workbook, Optional ByVal BookOpen As Boolean = True)

Dim nRow As Long
Dim Fname As Variant
Dim rngData As Range
Dim wsWeekly As Worksheet, ws As Worksheet
Dim wbDaily As Workbook

Application.ScreenUpdating = False

If Not BookOpen Then
    ' Select weekly workbook
    Fname = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls; *.xlsx), *.xls; *.xlsx", Title:="Select Weekly Workbook")
    If Fname = False Then Exit Sub                         'CANCEL is clicked
    ' Define weekly workbook while opening it
    On Error Resume Next
    Set wbWeekly = Workbooks(Dir(Fname))
    If wbWeekly Is Nothing Then
        Set wbWeekly = Workbooks.Open(Filename:=Fname, UpdateLinks:=False, IgnoreReadOnlyRecommended:=True)
    End If
    ' Define working sheet in wbWeekly. Change sheet name if required
    Set wsWeekly = wbWeekly.Sheets(wbWeekly.Sheets.Count)
    On Error GoTo 0
End If

Select Case wbWeekly.Sheets.Count
    Case 1
        Set wsWeekly = wbWeekly.Sheets("Day 1")
        If Not WorksheetFunction.CountA(wsWeekly.Cells) = 0 Then
            wbWeekly.Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Day " & wbWeekly.Sheets.Count + 1
            Set wsWeekly = wbWeekly.ActiveSheet
        End If
    Case Is > 1
        wbWeekly.Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Day " & wbWeekly.Sheets.Count + 1
        Set wsWeekly = wbWeekly.ActiveSheet
End Select

' Select daily Workbook
Fname = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls; *.xlsx), *.xls; *.xlsx", Title:="Select Daily Workbook")
If Fname = False Then Exit Sub                         'CANCEL is clicked
' Define opened Workbook as wbB while opening it.
Set wbDaily = Workbooks.Open(Filename:=Fname, UpdateLinks:=False, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)

For Each ws In wbDaily.Sheets
    ' This will select data block from range A3 to last data row in column J
    Set rngData = ws.Range("A3", ws.Cells(Rows.Count, "J").End(xlUp))
    ' Find paste point on wsWeekly with range A6 as initial target
    If wsWeekly.Range("A6") = "" Then
        nRow = 6
    Else
        nRow = wsWeekly.Cells(Rows.Count, "A").End(xlUp).Row + 1
    End If
    rngData.Copy wsWeekly.Range("A" & nRow)
Next

wbDaily.Close False
wbWeekly.Close True

End Sub

 

[Jones54]

Thanks JohnnyL,

Tried the code provided, but got the following error:

Microsoft Visual Basic for Applications, with a Red Stop symbol with the code 400.

Do I need to have the AM/PM/Nights work sheets open when I run this Macro?

 

[Jones54]

Thanks Zot,

Thanks for the code, I tried it but didn't seem to work. It did seem to me to be overly complicated (but that maybe because I am new to VBA). I just want to copy an open worksheet and paste it into an open workbook, then when I copy the second open sheet it pastes it into the original open workbook on the next available row.

 

[Zot]

Thanks Zot,

Thanks for the code, I tried it but didn't seem to work. It did seem to me to be overly complicated (but that maybe because I am new to VBA). I just want to copy an open worksheet and paste it into an open workbook, then when I copy the second open sheet it pastes it into the original open workbook on the next available row.

In my code you will have none of the workbooks opened. Just need to run the code and and it will create Weekly workbook. Then it will ask for daily workbook and will will cascade the AM, PM and night on next subsequent empty row and close all book once finished.

The Weekly will be created at the same folder as the program. The daily can be anywhere. No need open any file prior to program execution. Maybe it is not the flow you'd like I guess but I have tested it.

You want to manually create Weekly workbook
Open Daily workbook
Run macro and it will automatically copy sheet1, 2 and 3 in Daily workbook?

This is more manual but easily can be done. However, helpers out there may want to know how your Daily workbook like
1) Does it has only 3 sheet or more?
2) What is the sheet names? How you named them?

 

[mumps]

I'm a little confused. "2021 01-07 AM.xlsx" and "Wk 48 28-11-2021 to 30-11-2021.xlsx" are workbooks not worksheets. Do you want to copy Range("A3:J34") from the active sheet in the "2021 01-07 AM.xlsx" workbook to the first available row in the "Wk 48 28-11-2021 to 30-11-2021.xlsx" workbook? If so, what is the name of the sheet in the "Wk 48 28-11-2021 to 30-11-2021.xlsx" workbook where you want to paste the copied data?

 

[johnnyL]

Thanks JohnnyL,

Tried the code provided, but got the following error:

Microsoft Visual Basic for Applications, with a Red Stop symbol with the code 400.

Do I need to have the AM/PM/Nights work sheets open when I run this Macro?

For the code I posted, yes, it expects them to already be opened.

 

[Jones54]

I'm a little confused. "2021 01-07 AM.xlsx" and "Wk 48 28-11-2021 to 30-11-2021.xlsx" are workbooks not worksheets. Do you want to copy Range("A3:J34") from the active sheet in the "2021 01-07 AM.xlsx" workbook to the first available row in the "Wk 48 28-11-2021 to 30-11-2021.xlsx" workbook? If so, what is the name of the sheet in the "Wk 48 28-11-2021 to 30-11-2021.xlsx" workbook where you want to paste the copied data?

Apologies for the confusion. Let me run through the process to see if it makes more sense.

The operators complete a production sheet manually. I then take these manual sheets and input the info. into a worksheet (called template). for example the production sheets for the "AM" shift are entered into the template, once all "AM" data is complete the worksheet is closed and saved. This sheet is then copied and pasted into a folder named with the current month, eg currently "November" and named the following "2021 30-11 AM". This process is repeated for the "PM" shift & "Night shift" replacing the "AM" with either "PM" or "Nights". You therefore end up with 3 separate worksheets in the folder named "November" as follows:

2021 30-11 AM
2021 30-11 PM
2021 30-11 Nights

At the end of the week I open another excel worksheet called for example "wk 48 28-11-2021 to 30-11-2021" and currently copy and paste each excel worksheet (AM, PM & Nights) between the dates in the name of open worksheet "wk 48 28-11-2021 to 30-11-2021".

So what i am trying to do is to automate this copy & pasting and make it less time consuming.

So I will have the excel worksheet "wk 48 28-11-2021 to 30-11-2021" open within which i will have a command button with a code to copy & paste the info. from the worksheet "2021 30-11 AM" (which is also open) into the excel worksheet "wk 48 28-11-2021 to 30-11-2021". The "2021 30-11 AM" worksheet is closed and the worksheet "2021 30-11 PM" is opened. The command button in the worksheet is again pressed and the info from the worksheet "2021 30-11 PM" is again copied & pasted into the worksheet "wk 48 28-11-2021 to 30-11-2021" into the next available row. This happens for each shift within the dates identified.

Hope this helps.

 

[mumps]

I think the confusion is due to your use of the word "worksheet". I believe that you actually mean "workbook" instead. So "2021 30-11 AM" is actually a workbook and in that workbook, you will have a worksheet containing all the "AM" data. This macro assumes that the "wk 48 28-11-2021 to 30-11-2021" workbook, the "AM", "PM" and "Nights" workbooks are all open at the same time and that no other workbooks are open. It also assumes that the worksheets to be copied are the first worksheets in each workbook.

Sub CopyData()
    Application.ScreenUpdating = False
    Dim LastRow As Long, wb As Workbook
    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
                .Range(.Cells(1, 1), .Cells(LastRow, lcol)).Copy desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1)
            End With
        End If
    Next wb
    Application.ScreenUpdating = True
End Sub

Place the macro in the "wk 48 28-11-2021 t.o 30-11-2021" workbook and assign it to your button.