VBA copy data range from worksheets into new workbook

newyears

New Member
Joined
Apr 11, 2008
Messages
46
I have been searching the forum looking for an answer, but I can't find exactly what I'm looking for. I have issues trying to copy and index the paste. I appreciate any help

Here is what I'm trying to do:

User selects file that has multiple worksheets with different names. I want to copy rows 8 thru 15 from each worksheet into different workbook with sheet named "data" starting at row 1 and then pasting it. Data from next sheet (same file user selected) would be pasted below the first data set pasted -- all in workbook sheet named "data". It would loop thru each sheet and paste data below previous paste into workbook with sheet named "data".


Here is my code with copy and pasting...I used worksheet name "result" to copy one cell and paste in another workbook sheet "data". The user selected file has several different worksheet names (10 total), so I do not know how to loop and copy and paste advancing each paste.

Code:
    Dim Filter As String, Title As String
    Dim result As String
    Dim FilterIndex As Integer
    Dim wbsource As Workbook
        
    Dim wbdest As Workbook
    Set wbdest = ActiveWorkbook
        Dim Filename As Variant
        FFilter = "Excel Files (*.xls),*.xls," & _
        "Text Files (*.txt),*.txt," & _
        "All Files (*.*),*.*"
' Default Filter to *.*
FilterIndex = 3
Title = "Select a File to Open"
ChDrive ("c")
ChDir ("C:\Users\")
With Application
    ' ile Name to selected FileSet F
    Filename = .GetOpenFilename(Filter, FilterIndex, Title)
    ' Reset Start Drive/Path
    ChDrive (Left(.DefaultFilePath, 1))
    ChDir (.DefaultFilePath)
End With
' Exit on Cancel
If Filename = False Then
    MsgBox "No file was selected."
    Exit Sub
End If
Application.ScreenUpdating = False
    
wbdest.Unprotect
Set wbsource = Workbooks.Open(Filename)

wbsource.Sheets("result").Range("f8").Copy
wbdest.Sheets("data").Range("b4").PasteSpecial Paste:=xlPasteValues
 

Some videos you may like

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,537
Office Version
  1. 365
Platform
  1. Windows
How about
Code:
Sub newyears()
   Dim Fname As String
   Dim Destws As Worksheet
   Dim Wbk As Workbook
   Dim i As Long
   
   Set Destws = ThisWorkbook.Sheets("Data")
   ChDrive ("C:")
   ChDir ("C:\Users\")
   With Application
      Fname = .GetOpenFilename(, 3)
   End With
   Set Wbk = Workbooks.Open(Fname)
   Wbk.Sheets(1).Rows("8:15").Copy
   Destws.Range("A1").PasteSpecial xlPasteValues
   For i = 2 To Wbk.Sheets.Count
      Wbk.Sheets(i).Rows("8:15").Copy
      Destws.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
   Next i
   Wbk.Close False
End Sub
 

newyears

New Member
Joined
Apr 11, 2008
Messages
46
How about
Code:
Sub newyears()
   Dim Fname As String
   Dim Destws As Worksheet
   Dim Wbk As Workbook
   Dim i As Long
   
   Set Destws = ThisWorkbook.Sheets("Data")
   ChDrive ("C:")
   ChDir ("C:\Users\")
   With Application
      Fname = .GetOpenFilename(, 3)
   End With
   Set Wbk = Workbooks.Open(Fname)
   Wbk.Sheets(1).Rows("8:15").Copy
   Destws.Range("A1").PasteSpecial xlPasteValues
   For i = 2 To Wbk.Sheets.Count
      Wbk.Sheets(i).Rows("8:15").Copy
      Destws.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
   Next i
   Wbk.Close False
End Sub

Hello....I appreciate the reply. I tried this and it copied first sheet and pasted in workbook "data" but failed when trying to paste second set of data range. I get the "method range of object _worksheet failed" on Destws.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues

My assumption is the active sheet is the destination worksheet "data" and it does not know to back to original file and copy next worksheet.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,537
Office Version
  1. 365
Platform
  1. Windows
How about
Code:
Sub newyears()
   Dim Fname As String
   Dim Destws As Worksheet
   Dim Wbk As Workbook
   Dim i As Long
   
   Application.ScreenUpdating = False
   Set Destws = ThisWorkbook.Sheets("Data")
   ChDrive ("C:")
   ChDir ("C:\Users\")
   With Application
      Fname = .GetOpenFilename(, 3)
   End With
   Set Wbk = Workbooks.Open(Fname)
   Wbk.Sheets(1).Rows("8:15").Copy
   Destws.Range("A1").PasteSpecial xlPasteValues
   For i = 2 To Wbk.Worksheets.Count
      Wbk.Worksheets(i).Rows("8:15").Copy
      Destws.Range("A" & Destws.Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
   Next i
   Application.CutCopyMode = False
   Wbk.Close False
End Sub
 

newyears

New Member
Joined
Apr 11, 2008
Messages
46

ADVERTISEMENT

How about
Code:
Sub newyears()
   Dim Fname As String
   Dim Destws As Worksheet
   Dim Wbk As Workbook
   Dim i As Long
   
   Application.ScreenUpdating = False
   Set Destws = ThisWorkbook.Sheets("Data")
   ChDrive ("C:")
   ChDir ("C:\Users\")
   With Application
      Fname = .GetOpenFilename(, 3)
   End With
   Set Wbk = Workbooks.Open(Fname)
   Wbk.Sheets(1).Rows("8:15").Copy
   Destws.Range("A1").PasteSpecial xlPasteValues
   For i = 2 To Wbk.Worksheets.Count
      Wbk.Worksheets(i).Rows("8:15").Copy
      Destws.Range("A" & Destws.Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
   Next i
   Application.CutCopyMode = False
   Wbk.Close False
End Sub

I really appreciate your help on this. It worked without error, but it pasted the data over the same rows instead of pasting below the first set of data, etc. I see the line for count rows and paste but it did not advance. It's probably simple and I'll search around for some answers.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,537
Office Version
  1. 365
Platform
  1. Windows
Is there any particular column that will always have a value in every cell?
 

newyears

New Member
Joined
Apr 11, 2008
Messages
46

ADVERTISEMENT

Is there any particular column that will always have a value in every cell?

The worksheets each contain data from A to U and rows 8 to 15. I just need to paste this data from each worksheet into one workbook assuming the data from each sheet can be pasted subsequently below each one. There are only 6 to 8 worksheets to copy from the file. As I stated earlier, the worksheets have different names on them, but the data is same location on each.

Thank you for the help.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,537
Office Version
  1. 365
Platform
  1. Windows
If col A always has data in each of the 8 cells then the code will paste the next set of data under the previous set.
 

newyears

New Member
Joined
Apr 11, 2008
Messages
46
If col A always has data in each of the 8 cells then the code will paste the next set of data under the previous set.

Column A does not always have data, and once I entered data in column A for those rows it worked correctly. I'll have to think about how the data is entered on those work sheets.

Thank you for the help.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,537
Office Version
  1. 365
Platform
  1. Windows
As I said before
Is there any particular column that will always have a value in every cell?
 

Watch MrExcel Video

Forum statistics

Threads
1,109,377
Messages
5,528,333
Members
409,817
Latest member
JiNXX9500

This Week's Hot Topics

  • Change military grades into rank
    Afternoon all Need help with formula that will change military rank (i.e. 1, 2, 3 into Amn, A1C, SrA). Running IF formula that does not work...
  • VBA COUNTIF SOLUTION
    Hi The following are the errors spread across the several columns from E to Q ie. 13 columns across several sheets with more than 500 rows per...
  • INSERT ROW WITH SPECIFIS TEXT IN A COLUMN
    Hi All! How can identify that that the row to be inserted has to be inserted before 1st row with specific text in column F. If I record the...
  • Auto-Create a monthly Sign in sheet for preschool students
    The image below is what each page looks like. Above is space for the "Child Name" "Month" "Class" School days are obviously Monday-Friday but...
  • VBA vlookup multiple results
    Hi folks, Hopefully someone out there can help. I have a list to vlookup which works (ish). the lookup only picks up the first instance of the...
  • Extract values for earliest/latest times
    I am trying to put together a formula to get the earliest start time, the latest end time from column A for each person in Column B-F without the...
Top