Hi all,
I am trying to make a macro code which enables me to copy every column (with specific range) in one sheet of the active wb to a new wb, whereby each column is copied to a new sheet.
First I tried the following code:
Public Sub Transfer()
Application.ScreenUpdating = False
'-----------------------------------------
'DEFINE AND SET VARIABLES
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim ws1 As Worksheet
Dim rng As Range
Set wb1 = ThisWorkbook
Set ws1 = wb1.Worksheets("raw data")
LastCol = ActiveSheet.Cells(265, Application.Columns.Count).End(xlToLeft).Column
Set wb2 = Workbooks.Open("e:\27082014_GARCH_execution_destination.xlsm")
'-----------------------------------------
'COPY SUCESSIVE COLUMNS IN SOURCE WORKBOOK
With wb2
For I = 1 To LastCol - 46
If Worksheets.Count < I Then Sheets.Add After:=Sheets(Sheets.Count)
wb1.Activate
ws1.Activate
Range(Cells(265, 46 + I), Cells(515, 46 + I)).Select
Selection.Copy
'----------------------------------------
'PASTE TO SUCCESSIVE SHEETS IN DESTINATION BOOK
wb2.Worksheets(I).Activate
[b5].Select
ActiveSheet.Paste
Next I
'----------------------------------------
'CLEANUP
Set wb1 = Nothing
Set wb2 = Nothing
Set ws1 = Nothing
End With
Application.ScreenUpdating = True
End Sub
Which worked, except that it copied formula's instead of values and new sheets were blank sheets, while I would prefer new sheets to be the same as existing sheets in wb2.
I have no idea how to make new sheets in wb2 the same as existing sheets (so same content, formula's etc instead of just new blank sheets) and my adjustment (see below) gave me the following error: "PasteSpecial method of Worksheet class failed"
Public Sub Transfer()
Application.ScreenUpdating = False
'-----------------------------------------
'DEFINE AND SET VARIABLES
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim ws1 As Worksheet
Dim rng As Range
Set wb1 = ThisWorkbook
Set ws1 = wb1.Worksheets("raw data")
LastCol = ActiveSheet.Cells(265, Application.Columns.Count).End(xlToLeft).Column
Set wb2 = Workbooks.Open("e:\27082014_GARCH_execution_destin ation.xlsm")
'-----------------------------------------
'COPY SUCESSIVE COLUMNS IN SOURCE WORKBOOK
With wb2
For I = 1 To LastCol - 46
If Worksheets.Count < I Then Sheets.Add After:=Sheets(Sheets.Count)
wb1.Activate
ws1.Activate
Range(Cells(265, 46 + I), Cells(515, 46 + I)).Select
Selection.Copy
'----------------------------------------
'PASTE TO SUCCESSIVE SHEETS IN DESTINATION BOOK
wb2.Worksheets(I).Activate
[b5].Select
ActiveSheet.PasteSpecial xlPasteValues
Next I
'----------------------------------------
'CLEANUP
Set wb1 = Nothing
Set wb2 = Nothing
Set ws1 = Nothing
End With
Application.ScreenUpdating = True
End Sub
Thanks in advance!
Frans
I am trying to make a macro code which enables me to copy every column (with specific range) in one sheet of the active wb to a new wb, whereby each column is copied to a new sheet.
First I tried the following code:
Public Sub Transfer()
Application.ScreenUpdating = False
'-----------------------------------------
'DEFINE AND SET VARIABLES
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim ws1 As Worksheet
Dim rng As Range
Set wb1 = ThisWorkbook
Set ws1 = wb1.Worksheets("raw data")
LastCol = ActiveSheet.Cells(265, Application.Columns.Count).End(xlToLeft).Column
Set wb2 = Workbooks.Open("e:\27082014_GARCH_execution_destination.xlsm")
'-----------------------------------------
'COPY SUCESSIVE COLUMNS IN SOURCE WORKBOOK
With wb2
For I = 1 To LastCol - 46
If Worksheets.Count < I Then Sheets.Add After:=Sheets(Sheets.Count)
wb1.Activate
ws1.Activate
Range(Cells(265, 46 + I), Cells(515, 46 + I)).Select
Selection.Copy
'----------------------------------------
'PASTE TO SUCCESSIVE SHEETS IN DESTINATION BOOK
wb2.Worksheets(I).Activate
[b5].Select
ActiveSheet.Paste
Next I
'----------------------------------------
'CLEANUP
Set wb1 = Nothing
Set wb2 = Nothing
Set ws1 = Nothing
End With
Application.ScreenUpdating = True
End Sub
Which worked, except that it copied formula's instead of values and new sheets were blank sheets, while I would prefer new sheets to be the same as existing sheets in wb2.
I have no idea how to make new sheets in wb2 the same as existing sheets (so same content, formula's etc instead of just new blank sheets) and my adjustment (see below) gave me the following error: "PasteSpecial method of Worksheet class failed"
Public Sub Transfer()
Application.ScreenUpdating = False
'-----------------------------------------
'DEFINE AND SET VARIABLES
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim ws1 As Worksheet
Dim rng As Range
Set wb1 = ThisWorkbook
Set ws1 = wb1.Worksheets("raw data")
LastCol = ActiveSheet.Cells(265, Application.Columns.Count).End(xlToLeft).Column
Set wb2 = Workbooks.Open("e:\27082014_GARCH_execution_destin ation.xlsm")
'-----------------------------------------
'COPY SUCESSIVE COLUMNS IN SOURCE WORKBOOK
With wb2
For I = 1 To LastCol - 46
If Worksheets.Count < I Then Sheets.Add After:=Sheets(Sheets.Count)
wb1.Activate
ws1.Activate
Range(Cells(265, 46 + I), Cells(515, 46 + I)).Select
Selection.Copy
'----------------------------------------
'PASTE TO SUCCESSIVE SHEETS IN DESTINATION BOOK
wb2.Worksheets(I).Activate
[b5].Select
ActiveSheet.PasteSpecial xlPasteValues
Next I
'----------------------------------------
'CLEANUP
Set wb1 = Nothing
Set wb2 = Nothing
Set ws1 = Nothing
End With
Application.ScreenUpdating = True
End Sub
Thanks in advance!
Frans
Last edited: