Copy Columns From one worksheet and insert into another - vba excel - Stack Overflow

admin管理员组

文章数量:1287579

I want to copy columns from my source sheet (srcSht) to my destination sheet in a different workbook. I am new to VBA and have tried 2 versions. I created insertCols1 which is called from maincall(). I also tried to do it in insertCols2 as another way. I have hundreds of these to and this code would save so much time. I keep getting subscript out of range error. I have both worksheets open at the time. If possible - how could I do this without having the workbooks open?

Sub insertCols1(srcWB As String, destWb As String, sht As String)

    Windows("srcWb").Activate
    Sheets("sht").Columns("G:AE").Select
    Selection.Copy
    Windows("destWb").Activate
    Sheets("sht").Columns("A:A").Select
    Selection.Insert Shift:=xlToRight
    
End Sub

Sub maincall()

Call insertCols1("WA_Ja22Mar22.xlsx", "WA_Q1 Jan 22-Mar 22.xlsx", "AMX Q1 Done")

End Sub

'another version trying to what I wanted in insertCols1

Sub insertCols2()

   Worksheets("WA_Ja22Mar22.xlsx").Sheet("AMG Q1 PCP").Columns("G:AE").Copy
   Worksheets("WA_Q1 Jan 22-Mar 22.xlsx").Sheet("AMX Q1 Done").Columns("A:A").Insert   
   
End Sub

I want to copy columns from my source sheet (srcSht) to my destination sheet in a different workbook. I am new to VBA and have tried 2 versions. I created insertCols1 which is called from maincall(). I also tried to do it in insertCols2 as another way. I have hundreds of these to and this code would save so much time. I keep getting subscript out of range error. I have both worksheets open at the time. If possible - how could I do this without having the workbooks open?

Sub insertCols1(srcWB As String, destWb As String, sht As String)

    Windows("srcWb").Activate
    Sheets("sht").Columns("G:AE").Select
    Selection.Copy
    Windows("destWb").Activate
    Sheets("sht").Columns("A:A").Select
    Selection.Insert Shift:=xlToRight
    
End Sub

Sub maincall()

Call insertCols1("WA_Ja22Mar22.xlsx", "WA_Q1 Jan 22-Mar 22.xlsx", "AMX Q1 Done")

End Sub

'another version trying to what I wanted in insertCols1

Sub insertCols2()

   Worksheets("WA_Ja22Mar22.xlsx").Sheet("AMG Q1 PCP").Columns("G:AE").Copy
   Worksheets("WA_Q1 Jan 22-Mar 22.xlsx").Sheet("AMX Q1 Done").Columns("A:A").Insert   
   
End Sub

• excel
• vba

Share Improve this question Follow asked Feb 23 at 19:02 Julie4435637Julie4435637 15388 bronze badges 3

• For workbooks which may not be open - are they all stored in a fixed location? If not, then how can they be opened knowing only the workbook name? – Tim Williams Commented Feb 23 at 20:06
• All of the source workbooks will be in the same folder and the all of the destination workbooks are in a different folder. Therefore only 2 folders: source; destination. – Julie4435637 Commented Feb 24 at 4:28
• Does each pair of source/destination workbooks only involve copying one sheet? If a workbook needs to be opened can it be closed immediately after? – Tim Williams Commented Feb 24 at 16:16

Add a comment  | 

1 Answer 1

Sorted by: Reset to default 2

You shouldn't have quotes around those variables srcWb, sht, etc.

Added some code to handle opening workbooks which aren't already loaded.

Try like this:

Const SOURCE_FOLDER As String = "C:\Source\"
Const DEST_FOLDER As String = "C:\Destination\"

Sub maincall()
    insertCols1 "WA_Ja22Mar22.xlsx", "WA_Q1 Jan 22-Mar 22.xlsx", "AMX Q1 Done"
End Sub

Sub insertCols1(srcWB As String, destWb As String, sht As String)
    Dim wbSrc As Workbook, wbDest As Workbook
    
    Set wbSrc = GetWb(srcWB, "S")
    Set wbDest = GetWb(destWb, "D")
    
    wbSrc.Worksheets(sht).Columns("G:AE").Copy
    wbDest.Worksheets(sht).Columns("A").Insert Shift:=xlToRight
    
    wbSrc.Close False
    wbDest.Close True
End Sub

'return workbook with name `wbName` if already open, otherwise open it
'   from either "source" or "destination" folder
Function GetWb(wbName As String, wbType As String) As Workbook
    Dim pth As String, wb As Workbook
    
    On Error Resume Next
    Set GetWb = Workbooks(wbName) 'is workbook already open?
    On Error GoTo 0
    
    If GetWb Is Nothing Then      'found wb?
        Select Case UCase(wbType) 'source or destination?
            Case "S"
                Set GetWb = Workbooks.Open(SOURCE_FOLDER & wbName, ReadOnly:=True)
            Case "D"
                Set GetWb = Workbooks.Open(DEST_FOLDER & wbName)
            Case Else
                MsgBox "wbType must be 'S' or 'D'", vbCritical, "Error"
        End Select
    End If
End Function

本文标签： Copy Columns From one worksheet and insert into anothervba excelStack Overflow