Results 1 to 6 of 6
  1. #1
    New Lounger
    Join Date
    Aug 2014
    Posts
    4
    Thanks
    0
    Thanked 0 Times in 0 Posts

    VBA Question: Combining commands to copy data to different workbooks and different sheets

    Hi everyone,

    First of all, I am new to this forum and I am grateful for the overview of previous questions!

    By various old post I now know how to easily copy large number of sheets in one workbook with VBA.

    However, now I will have to combine various commands in VBA for my newest problem and I am too big a noob to know the right way to combine commands.

    I don't know how to attach excel documents to posts so I will try to describe my problem as detailed as possible.

    I have two workbooks ("workbook 1" and "workbook 2") where workbook 1 has a very large table on sheet "raw data" and workbook 2 has a large amount of sheets starting with "sheet 1", followed by "sheet 2", "sheet 3", etc.

    Basically, I need my macro to copy 251 observations from workbook 1; sheet raw data; cell range AU265:AU515 to workbook 2; sheet 1; cell range B5:B255

    Next, I would like the macro to continue with the next column of data: workbook 1; sheet raw data; cell range AV265:AV515 to workbook 2; sheet 2; cell range B5:B255 and to continue this until there are no more columns of data on workbook 1; sheet raw data and likewise no more sheets on workbook 2

    If things are unclear, maybe someone can explain to me how to post or attach excel files?

    Thanks in advance!

    Kind regards,

    Frans Wasmann

  2. #2
    Bronze Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    1,294
    Thanks
    47
    Thanked 257 Times in 237 Posts
    fwasmann,

    The following code will open your destination workbook and copy successive columns from you source workbook to successive sheets using the ranges you specify. If there are more columns to be copied then there are sheets then new sheets will be created. Change the path and name of your destination workbook.

    HTH,
    Maud

    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("c:\Users\Maudibe\Desktop\Workbook2.xlsx") 'CHANGE PATH AND NAME
    '-----------------------------------------
    '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

  3. #3
    New Lounger
    Join Date
    Aug 2014
    Posts
    4
    Thanks
    0
    Thanked 0 Times in 0 Posts
    Hi Maud,

    First of all, thanks for your reply.

    I run the macro as you described and changed my destination wb path.

    Everything went fine, except that it pasted the formula instead of values. I tried to change the "ActiveSheet.Paste" line with "ActiveSheet.PasteSpecial xlPasteValues" and with "ActiveSheet.PasteSpecial Paste:=xlPasteValues" but neither worked (see below):

    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 Paste:=xlPasteValues
    Next I
    '----------------------------------------
    'CLEANUP
    Set wb1 = Nothing
    Set wb2 = Nothing
    Set ws1 = Nothing
    End With
    Application.ScreenUpdating = True
    End Sub

    With this code I get the Application-defined or object-defined error.

    Second try:
    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

    The second code gives me the "PasteSpecial method of Worksheet class failed" error.

    I hope you can help me with this final error!

    Anyway, thanks for you quick previous reply.

    Ciao,

    Frans
    Last edited by fwasmann; 2014-08-27 at 07:24.

  4. #4
    New Lounger
    Join Date
    Aug 2014
    Posts
    4
    Thanks
    0
    Thanked 0 Times in 0 Posts
    Almost forgot:

    Could it also be possible to have new sheets in wb2 with the same content, formula's, format etc as existing sheets in wb2?

    So basicly copy sheet 1 in wb2 instead of creating blank new sheets when there are more columns in wb1 than sheets in wb2.

    Thanks!

  5. #5
    New Lounger
    Join Date
    Aug 2014
    Posts
    4
    Thanks
    0
    Thanked 0 Times in 0 Posts
    I fixed the paste special error by with the following adjustment:

    ActiveCell.PasteSpecial instead of ActiveSheet.PasteSpecial

    No idea how to fix the new sheets in wb2 problem: new sheets to have the same format and formula's as existing sheets in wb2 (all existing sheets in wb2 are the same).

    Regards,

    Frans

  6. #6
    Bronze Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    1,294
    Thanks
    47
    Thanked 257 Times in 237 Posts
    fwasmann,

    Here is the amended code that will copy the last sheet in the destination workbook if needed, append it to the end, then paste the values as before. Your formulas and formatting will be preserved on to the new sheet.

    HTH,
    Maud


    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("c:\Users\Maudibe\Desktop\Workbook2.xlsx") 'CHANGE PATH AND NAME
    '-----------------------------------------
    'COPY SUCESSIVE COLUMNS IN SOURCE WORKBOOK
    With wb2
    For I = 1 To LastCol - 46
        If Worksheets.Count < I Then
            Worksheets(I - 1).Select
            Application.CutCopyMode = False
            Worksheets(I - 1).Copy After:=Worksheets(I - 1)
        End If
        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
        ActiveCell.PasteSpecial
    Next I
    '----------------------------------------
    'CLEANUP
    Set wb1 = Nothing
    Set wb2 = Nothing
    Set ws1 = Nothing
    End With
    Application.ScreenUpdating = True
    End Sub

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •