Pasting from one workbook with multiple sheets to various workbooks

[motopdx]

I'm trying to paste from one workbook with multiple sheets to several different workbooks. Example: Workbook "X" has 50 sheets labeled 1-50. I need each sheet copied to the respective workbook "Y". Each sheet in workbook "X" can have a different range of active cells that need to be copied over.

Examples:
workbook "X" sheet "1" copied to workbook "Y" sheet "Jan" (cell A2 to cell Z50)
workbook "X" sheet "2" copied to workbook "Y" sheet "Jan" (cell A2 to cell Z125)

Here is what I was trying with no luck and probably not even close.

Sub Data_Feb()
Dim x As Workbook
Dim y As Workbook

Set x = Workbooks.Open("workbook file path")
Set y = Workbooks.Open("workbook file path")

'Copy from workbook "X" & specific sheet
x.Sheets("584").Range ("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

'Paste to workbook "Y"
y.Sheets("Feb").Range("A2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Close & Save workbooks
x.Close
y.Save
y.Close

 

[motopdx]

Yes you're correct. I didn't realize that is how the code works. However, I have fixed the naming convention (see below) but I'm getting this error. Not certain if this is affected by me being on a global desktop with my company.

 

[yinkajewole]

I ran the code on my pc and it worked successfully without errors.
Can you try it on files that reside on an independent PC?

 

[motopdx]

Amazing Macro! I've added it to a one drive folder and then accessed it from my desktop and not global desktop. Is there any way this macro would work from a global desktop or why it's not working being on a global desktop? Is it the file path breaking the macro?

 

[yinkajewole]

I'm sorry, it's not being a global desktop that cause the issue. This should solve it and let me have a feedback:

Sub copySheetData()
Dim w1 As Workbook, w2 As Workbook, sel As Boolean, folder$, fol As FileDialog, ws As Worksheet
Dim sourceD As String, sMonth As String, adDr As Variant
If MsgBox("Please, Click Yes to choose the source file", vbYesNo) = vbYes Then

    With Application.FileDialog(msoFileDialogFilePicker)
        ' show the file picker dialog box
        If .Show <> 0 Then sourceD = .SelectedItems(1)
    End With
Else
Exit Sub
End If

MsgBox "Please, select the folder of the Business Location"
Set fol = Application.FileDialog(msoFileDialogFolderPicker)
fol.AllowMultiSelect = False
sel = fol.Show
If sel Then folder = fol.SelectedItems(1) & "\" Else Exit Sub
sMonth = InputBox("Input the month")
Set w1 = Workbooks.Open(sourceD)
For Each ws In w1.Worksheets
    If FileThere(folder & ws.Name & " " & Format(Date, "yyyy") & ".xlsx") Then
    Set w2 = Workbooks.Open(folder & ws.Name & " " & Format(Date, "yyyy") & ".xlsx")
    a = Split(ws.UsedRange.Address, "$")
        For i = 0 To UBound(a)
        If adDr = "" Then adDr = a(i) Else adDr = adDr & a(i)
        Next i
        On Error GoTo nFound
    w2.Worksheets(sMonth).Range(adDr).Value = ws.UsedRange.Value
    w2.Save
    w2.Close
    n = n + 1
    End If
    adDr = ""
Next ws
Application.DisplayAlerts = False
w1.Close
Application.DisplayAlerts = True
MsgBox IIf(n > 0, n & " files copied", "Files not found")
Exit Sub
nFound:
MsgBox "Month not found"
End Sub
Function FileThere(filename As String) As Boolean
     FileThere = (Dir(filename) > "")
End Function

 

[motopdx]

This above change works, thank you. However, when the macro paste into the workbooks there was a table and when the macro paste the data the table is removed. Not a big deal but if its an easy change that would be great. This has tremendously helped me, again thank you.

Before

After