Pasting data from other user defined workbook difficulties

[Darkcloud617]

Hello all,

I have been working on this code to
1. let user pick file
2. copy all cells that contain data on sheet 1, 2, 3, 4 and over 30
3. paste into first blank row of source workbook on Sheet 4

For some reason this seems to only paste one cell into "A" on sheet 4 on the first blank row of source workbook. I cant figure out how to make it copy all data (cells that contain data) from user defined workbook (wb2, with multiple sheets) and paste into source workbook (wb1) on sheet 4 on first blank row. Any help is greatly appreciated.

Sub Notes1()
'Last row in column
Dim WS As Worksheet
Dim LastCell As Range
Dim LastCellRowNumber As Long


Set WS = Worksheets("Sheet 4")
With WS
    Set LastCell = .Cells(.Rows.Count, "C").End(xlUp)
    LastCellRowNumber = LastCell.Row + 1
End With


Dim wb As Workbook, wb2 As Workbook
Dim vFile As Variant


'Set source workbook
Set wb = ActiveWorkbook


'Open the target workbook
vFile = Application.GetOpenFilename("Excel-files,*.xlsx", _
    1, "Select File To Open", , False)


'if the user didn't select a file, exit sub
If TypeName(vFile) = "Boolean" Then Exit Sub
Workbooks.Open vFile


'Set selectedworkbook
Set wb2 = ActiveWorkbook


'Go to selected workbook
wb2.Activate


'Select cells to copy
Sheets("Week 1").Activate
wb2.Worksheets("Week 1").Rows.End(xlUp).Offset(1, 0).Select
Selection.Copy




'Go back to original workbook
wb.Activate


'Paste Row starting at the last empty row
wb.Worksheets("Sheet 4").Range("C" & LastCellRowNumber).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False
Application.ScreenUpdating = True






'repeats
wb2.Activate
Sheets("Week 2").Activate
wb2.Worksheets("Week 2").Rows.End(xlUp).Offset(1, 0).Select
Selection.Copy


wb.Activate
wb.Worksheets("Sheet 4").Range("A" & LastCellRowNumber).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False
Application.ScreenUpdating = True




wb2.Activate
Sheets("Week 3").Activate
wb2.Worksheets("Week 3").Rows.End(xlUp).Offset(1, 0).Select
Selection.Copy


wb.Activate
wb.Worksheets("Sheet 4").Range("A" & LastCellRowNumber).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False
Application.ScreenUpdating = True


wb2.Activate
Sheets("Week 4").Activate
wb2.Worksheets("Week 4").Rows.End(xlUp).Offset(1, 0).Select
Selection.Copy


wb.Activate
wb.Worksheets("Sheet 4").Range("A" & LastCellRowNumber).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False
Application.ScreenUpdating = True




wb2.Activate
Sheets("Over 30").Activate
wb2.Worksheets("Over 30").Rows.End(xlUp).Offset(1, 0).Select
Selection.Copy


wb.Activate
wb.Worksheets("Sheet 4").Range("A" & LastCellRowNumber).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False
Application.ScreenUpdating = True






'Close
wb2.Close


End Sub

 

[JLGWhiz]

See if this works for you

Sub Notes2()
'Last row in column
Dim WS As Worksheet, shAry As Variant, i As Long
Dim wb As Workbook, wb2 As Workbook
Dim vFile As Variant
'Set source workbook
Set wb = ActiveWorkbook
With wb
    shAry = Array(.Sheets("Week 1"), .Sheets("Week 2"), .Sheets("Week 3"), .Sheets("Week 4"), .Sheets("Over 30"))
End With
Set WS = Worksheets("Sheet 4")
With WS
    Set LastCell = .Cells(.Rows.Count, "C").End(xlUp)
    LastCellRowNumber = LastCell.Row + 1
End With
'Open the target workbook
vFile = Application.GetOpenFilename("Excel-files,*.xlsx", _
    1, "Select File To Open", , False)
'if the user didn't select a file, exit sub
If TypeName(vFile) = "Boolean" Then Exit Sub
Application.ScreenUpdating = False
Set wb2 = Workbooks.Open(vFile)
    For i = LBound(shAry) To UBound(shAry)
        shAry(i).UsedRange.Offset(1).Copy
        wb.Cells(Rows.Count, 3).End(xlUp)(2).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
    Next
Application.ScreenUpdating = True
'Close
wb2.Close False
End Sub

 

[MARK858]

Cross-posted without a link here

 

[JLGWhiz]

In the code you posted that searches through other worksheets in another workbook and pastes the code... how do you force it to copy and paste with the blank included in the rows? It also seems that code pastes the values starting in column 'C'? What area controls that?

Regarding your private message, the 3 in this line of code designates column 3 (C).

[LEFT][COLOR=#333333][FONT=monospace] wb.Cells(Rows.Count, 3).End(xlUp)(2).PasteSpecial xlPasteValues
[/FONT][/COLOR][/LEFT]

The End(xlUp)(2) finds the next available row in that column.
I used that because the original code used column C as the destination column. The copy part of tghe code uses "UsedRange.Offset(1)" as the copy area. That gets everything but the header row. If you have more questions, please post them to the thread so all can see and participate in the solution.

 

[Darkcloud617]

I am just full of bad decisions on this board. I apologize. For some reason, this does not seem to be running correctly but I am unsure which part is the issue. I created a small mock up to demonstrate. It should copy all of the data from the 5 sheets and copy them one under another but it seems to copy over itself anyway?

Here is the excel wkbk to copy from: ufile.io/fkz2z and the source wkbk: ufile.io/6r9yf.

 

[JLGWhiz]

I had a couple of errors in the code I posted. See if this revised version works better.

Sub Notes3()
'Last row in column
Dim WS As Worksheet, shAry As Variant, i As Long
Dim wb As Workbook, wb2 As Workbook
Dim vFile As Variant
'Set source workbook
Set wb = ActiveWorkbook
With wb
    shAry = Array(.Sheets("Week 1"), .Sheets("Week 2"), .Sheets("Week 3"), .Sheets("Week 4"), .Sheets("Over 30"))
End With
Set WS = wb.Worksheets("Sheet 4")
'Open the target workbook
vFile = Application.GetOpenFilename("Excel-files,*.xlsx", _
    1, "Select File To Open", , False)
'if the user didn't select a file, exit sub
If TypeName(vFile) = "Boolean" Then Exit Sub
Application.ScreenUpdating = False
Set wb2 = Workbooks.Open(vFile)
    For i = LBound(shAry) To UBound(shAry)
        shAry(i).UsedRange.Offset(1).Copy
        WS.Cells(Rows.Count, 3).End(xlUp)(2).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
    Next
Application.ScreenUpdating = True
'Close
wb2.Close False
End Sub

 

[Darkcloud617]

It so strange that it seems to work with certain rows or areas but completely miss the others... As an example (from the actual data I am trying to move), I manually counted a total of 391 files (rows) that needed transferred over using this formula but in the end it only copied a total of 129. And so strangely that I cannot make it work.

I made the mock up be a little more specific to narrow down the issue and it seems to not populate the last rows correctly as it pastes (highlighted in yellow)? If you compare the 'copyfromfile' to the 'SourceMacro' it does not line up correctly and pastes differently than it appears on the 'copyfromfile'. This should just copy all of the data from the sheets 'as is' and paste one under another in the SourceMacro sheet?

I am so lost and I am sorry to be such a nuisance and feel terrible I cannot just get it working myself... I just really need to get this working and cant find the error.

http://www.filedropper.com/sourcemacro

http://www.filedropper.com/copyfromfile

Thank you for all of your help

 

[JLGWhiz]

I won't attempt to access your files on the site you are using to share. If your sheet names do not match exactly the names used in the array, then vba will ignore them as unmatched names. So you need to check you sheet names for leading or trailing spaces, difference in Upper/Lower case letters and extra or no spaces between text. Those are the common causes of mismatched sheet names.

If you open the vb editor, click once anywhere in the body of the code, then press F8 function key you can step through the code one line at a time and see what the code does as each line executes. That will allow you to see when it does not copy properly and which line of code did not properly execute. You can then check that worksheet for anomalies that would cause the problem.