VBA open file and copy

[Orxan]

Hello Excel VBA experts,

I would like to ask your advise or solution in order to automate one process which is time consuming.

I would like to automate following steps.

1) Copy this template to generate new sheet (copy sheet) in this workbook (Template sheet should be blank as an example)
2) Open browse function with help of FileToOpen
3) Copy data from the opened workbook to this new sheet including headers and format
4) Copy region in opened workbook is B1:O50
5) then close opened workbook with OpenBook.close
6) Change Template name to the data in B20

This process should continue 40 times as the process requires to combine 40 different sheets from several workbooks.


Thank you all in advance.

 

[JLGWhiz]

Two things were not clear. 1) Where to paste the copied range?.(A6 or B5) and which sheet does B20 for the name refer to?(Source sheet or Destination Sheet.

Sub t()
Dim cpyFile As String, wb As Workbook, sh As Worksheet
Sheets("Template").Copy After:=Sheets(Sheets.Count)
Set sh = Sheets(Sheets.Count)
cpyFile = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*")
Set wb = Workbooks.Open(cpyFile)
wb.Sheets(1).Range("B1:O50").Copy sh.Range("A5") 'not sure this is correct
sh.Name = wb.Sheets(1).Range("B20").Value 'not sure this is correct
wb.Close False
End Sub

 

[Orxan]

Hello,

Thank you very much for reply.

1) Copied range should paste to cell A19
2) the sheet name should refer to B20. B20 will be sheet name once you paste the copied range to A19.

my question should I add loop in order to continue process 40 times?

Thank you

 

[JLGWhiz]

I am still not clear on which sheet the B20 cell is on. Can you express it as Source Sheet B20 or Destination Sheet B20? I ask this because the columns and rows change during the copy/paste process. The A16 I can understand OK.

 

[JLGWhiz]

Should have been A19 .
See if this is what you want.

Sub t3()
Dim cpyFile As String, wb As Workbook, sh As Worksheet
For i = 1 To 40
    Sheets("Template").Copy After:=Sheets(Sheets.Count)
    Set sh = Sheets(Sheets.Count)
    cpyFile = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*")
    Set wb = Workbooks.Open(cpyFile)
    wb.Sheets(1).Range("B1:O50").Copy sh.Range("A19")
    sh.Name = wb.Sheets(1).Range("B20").Value 'not sure this is correct
    wb.Close False
Next
End Sub

 

[Orxan]

Hello again,

I have updated the code that you sent me. Everything works perfectly but I have 2 issues.
1) Step 3 - In sheet 2 I have a column where it indicates how many sheets I have to open and copy. Let's say I have 10 cells in Column J and it indicates that I have to copy 10 different tabs to my workbook. I would like to write a code that will launch browse to copy 10 times continuously.
2) I would like to paste copied range as PasteSpecial xlPasteValuesAndNumberFormat but when I write the code next to the step 9 it shows error.


Sub copydata()

Dim cpyFile As String, wb As Workbook, sh As Worksheet 'step 1
Dim i As Byte 'Step 2
i = 1 to WorksheetFunction.CountIf(Sheet2.Range("J2:J60"), "TO BE INCLUDED") 'Step 3

Application.ScreenUpdating = False 'Step 4
Application.EnableEvents = False 'Step 5

Sheets(4).Copy After:=Sheets(Sheets.Count) 'Step 6

Set sh = Sheets(Sheets.Count) 'Step 7
cpyFile = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*") 'Step 7
Set wb = Workbooks.Open(cpyFile) 'Step 8
wb.Sheets(1).Range("C4:O50").Copy sh.Range("A19") 'Step 9

wb.Close False 'Step 10

ActiveSheet.Name = ActiveSheet.Range("B19") 'Step 11
Application.ScreenUpdating = True 'Step 12

Next i 'Step 13


End Sub 'Step 14

Your help much appreciated!

 

[JLGWhiz]

I suppose my question about B20 is answered in an indirect way as being B19. But I don't use ActiveSheet for a reference because I have a variabole assigned to the new sheet and I like to be consistent in referring to objects. See it this fixes your two issues.

Sub t4()
Dim cpyFile As String, wb As Workbook, sh As Worksheet
For i = 1 To Application.CountIf(Sheet2.Range("J2:J60"), "TO BE INCLUDED")
    Sheets("Template").Copy After:=Sheets(Sheets.Count)
    Set sh = Sheets(Sheets.Count)
    cpyFile = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*")
    Set wb = Workbooks.Open(cpyFile)
    wb.Sheets(1).Range("B1:O50").Copy
    sh.Range("A19").PasteSpecial xlPasteValuesAndNumberFormats
    sh.Name = sh.Range("B19").Value 'not sure this is correct
    wb.Close False
    Set sh = Nothing
Next
End Sub

 

[Orxan]

Hello again,

I updated my code and I just want to add one additional feature for copied range.

I would like to replace xlPasteFormulasAndNumberFormats function with Paste Special where I will keep format of copied region (colour ect) and paste the range as values (without formulas).
Could you please assist me on that?

Sub t4()
Dim cpyFile As String, wb As Workbook, sh As Worksheet
Dim i As Byte
Dim NewName As String


For i = 1 To Application.CountIf(Sheet2.Range("J2:J60"), "TO BE INCLUDED")
Sheets("Template").Copy After:=Sheets(Sheets.Count)
Set sh = Sheets(Sheets.Count)

cpyFile = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*")
Set wb = Workbooks.Open(cpyFile)
wb.Sheets(1).Range("C4:O70").Copy
sh.Range("A19").PasteSpecial xlPasteFormulasAndNumberFormats

Application.CutCopyMode = False
Application.DisplayAlerts = False

wb.Close False

NewName = InputBox("enter CO ID")
sh.Name = NewName

Set sh = Nothing
Next
End Sub

 

[JLGWhiz]

I would like to replace xlPasteFormulasAndNumberFormats function with Paste Special

If you had copied the code in Post #7 and pasted it into your code module it would do that. It is much easier to copy and paste than to retype.