VBA code to copy data from one workbook to another

[Declanscully]

This might be too much of an ask, or it might be much simpler than I think.

I am looking for some VBA code to open a workbook, and copy certain cells from each worksheet into the new workbook.

The open workbook part this works perfectly:

Sub GetFile()
Dim fileNameAndPath As Variant
fileNameAndPath = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLS), *.XLS", Title:="Select File To Be Opened")
If fileNameAndPath = False Then Exit Sub
Workbooks.Open Filename:=fileNameAndPath
End Sub

The trick then is I want to copy specific cells from multiple worksheets in the opened workbook to cells in the new work book (J3 to A1), I don't mind brute forcing the copy portion, it will be easier for me to follow.

But I am not sure how to cycle through the worksheets so that I can get all the required data.

 

[smozgur]

I am not sure if I understood completely, but if you mean copying cell J3 values from each worksheet in the opened workbook into the first worksheet of a new workbook, starting from A1, then A2, A3, and so on, then please try the following code. Even I am wrong about my assumption about the destination, it will give you idea about looping through the worksheets.
If I didn't get it then please let us know with a bit more detailed information.

Sub GetFile()
Dim fileNameAndPath As Variant
Dim newWrk As Workbook
Dim wrk As Workbook
Dim sht As Worksheet
Dim rng As Range

fileNameAndPath = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLS), *.XLS", Title:="Select File To Be Opened")
If fileNameAndPath = False Then Exit Sub

' Set wrk variable as the opened workbook
Set wrk = Workbooks.Open(FileName:=fileNameAndPath)

' And create a new workbook then set newWrk variable
Set newWrk = Application.Workbooks.Add

' Destination cell in the first worksheet of the new workbook - A1
Set rng = newWrk.Worksheets(1).Range("A1")

' Loop through worksheets in the opened workbook, and copy cell J3 value to the new worksheet, to A1, A2, A3 ....
For Each sht In wrk.Worksheets
    rng.Value = sht.Range("J3")
    Set rng = rng.Offset(1)
Next sht

End Sub

 

[Declanscully]

I am not sure if I understood completely, but if you mean copying cell J3 values from each worksheet in the opened workbook into the first worksheet of a new workbook, starting from A1, then A2, A3, and so on, then please try the following code. Even I am wrong about my assumption about the destination, it will give you idea about looping through the worksheets.
If I didn't get it then please let us know with a bit more detailed information.

Sub GetFile()
Dim fileNameAndPath As Variant
Dim newWrk As Workbook
Dim wrk As Workbook
Dim sht As Worksheet
Dim rng As Range

fileNameAndPath = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLS), *.XLS", Title:="Select File To Be Opened")
If fileNameAndPath = False Then Exit Sub

' Set wrk variable as the opened workbook
Set wrk = Workbooks.Open(FileName:=fileNameAndPath)

' And create a new workbook then set newWrk variable
Set newWrk = Application.Workbooks.Add

' Destination cell in the first worksheet of the new workbook - A1
Set rng = newWrk.Worksheets(1).Range("A1")

' Loop through worksheets in the opened workbook, and copy cell J3 value to the new worksheet, to A1, A2, A3 ....
For Each sht In wrk.Worksheets
    rng.Value = sht.Range("J3")
    Set rng = rng.Offset(1)
Next sht

End Sub

 

[Declanscully]

Smozgur I will try to explain better:

• There are two work books to begin with, lets call them Test_01 and Test_02
• Test_01 will have the code in it with a button to import the data from Test_02
  • Test_02 is opened using the short bit of code I started with.
• Test__02 will have a number of worksheets from 1 up. These worksheets will have a unique name which changes based on the date and project number. An example would be 22001-01012022,22001-01022022 etc.

Test_01 is a file that compiles the costs associated with the projects based off of these individual timesheets. The cells that are been copied are the same cells on each sheet, but will advance a row on Test_01 with each worksheet.

As an example:

Test_01 - Compiled data	Test_02 - (Sheet1)
A5	J1
B5	J61
C5	J27
D5	J39
E5	J50
F5	J60

Then Test_02 (sheet2) would move to row 6 of Test_01.

I have tried to convince the powers that be that they need to invest in an access database for time and entry and tracking purposes but they are of an older generation and think that excel works so why not stick with it. I figured if I can even come close to automating these sheets then I maybe able to push them into hiring someone who knows what they are doing rather than me ham fisting stuff.

 

[Declanscully]

Sorry I had the sheets the wrong way around but the principle is the same.

Test_01.xlsm
	C	D	E	F	G
55
22001-01012022

Cells with Data Validation
Cell	Allow	Criteria
C51:G59	List	=#REF!

Test_02.xlsx
	C	D
3	LABOR
JOB NUMBER

 

[smozgur]

The sample code that I wrote above should be able to do what you need with some changes.

Instead of creating a new workbook (because I assumed that since you said "new workbook"), the active workbook, in fact, the active worksheet should be used (I think). Still, in the following modified code, I provided three different scenarios just in case;
The destination sheet is:

1. the active worksheet (where the button resides).
2. another worksheet in the workbook.
3. supposed to be a new worksheet.

You can uncomment the one according to your situation. (Currently the ActiveSheet version is used below)

Sub GetFile()
Dim fileNameAndPath As Variant
Dim shtDest As Worksheet
Dim wrk As Workbook
Dim sht As Worksheet
Dim rng As Range

fileNameAndPath = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLS), *.XLS", Title:="Select File To Be Opened")
If fileNameAndPath = False Then Exit Sub

' 1- Destination sheet - assuming it is active sheet
Set shtDest = ActiveSheet
' 2- If the button is not on the same sheet then you should set the destination sheet with its name
'  Set shtDest = ThisWorkbook.Worksheets("DestinationSheetName")
' 3- If it will be a new worksheet then:
'  Set shtDest = ThisWorkbook.Worksheets.Add

' Set wrk variable as the opened workbook
Set wrk = Workbooks.Open(FileName:=fileNameAndPath)

' Destination cell in the destination sheet of this workbook - A1
Set rng = shtDest.Range("A1")

' Loop through worksheets in the opened workbook, and copy cell J3 value to the destination sheet, to A1, A2, A3 ....
For Each sht In wrk.Worksheets
    rng.Value = sht.Range("J3")
    Set rng = rng.Offset(1)
Next sht

End Sub

The cells that are been copied are the same cells on each sheet, but will advance a row on Test_01 with each worksheet.

However, I still can't see the "same cells" definition in the question. So, the sample code is only copying a single cell from each worksheet, J3. If the source range consists of multiple cells, then the code should be modified. Perhaps if you could also define the "same cells" then we could provide more help.

Note: To use the XL2BB, select the range that you want to create a mini-sheet, then click on the button to generate the BB code.

 

[Declanscully]

Sorry first time using the mini sheet, but yes this code does with with the slight modification to the cells that are been used, thank you very much.

 

[smozgur]

Sorry first time using the mini sheet, but yes this code does with with the slight modification to the cells that are been used, thank you very much.

You're welcome. Glad to hear it helps.