vba copy columns from workbook to another based on sheet name in cell value

hwexcel

New Member
Joined
Apr 18, 2013
Messages
4
I created the code as following, but it popup error message.....but I don't know how to debug it.....Sorry that I am new in VBA, please any expert can teach me how to make the code run well, many thanks.

Sub copypaste()'This macro will copy data from worksheets and past to "Target" sheet


Dim nLastCol As Long, nLastRow As Long, i As Long
Dim nTargetLastRow As Long
Dim ws As Worksheet
Dim wsTarget As Worksheet
Dim oriPath As String
dim newPath as string
dim cRange as string
Dim sFil As String
dim oriWS as string
dim newWS as string


Dim thisWB As Workbook
Dim oriWB As Workbook
dim newWB as workbook




With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
.CutCopyMode = False '<--------
End With


On Error GoTo 0


Set thisWB = ThisWorkbook
oriPath = thisWB.Sheets("CopySheetCover").Range("A2").Value 'Change to suit
newPath = thisWB.Sheets("CopySheetCover").Range("A5").Value
cRange = thisWB.Sheets("CopySheetCover").Range("A8").Value 'e.g.A:E


Set oriWB = Workbooks.open(oriPath)
Set newWB = Workbooks.open(newPath)
nLastRow = thisWB.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1




For i = 11 to nLastRow




'Define the range and copy
oriWS = thisWB.Sheets("CopySheetCover").Range(i,"A").Value
newWS = thisWB.Sheets("CopySheetCover").Range(i,"B").Value

For Each ws In oriWB.Sheets
If InStr(1, ws.Name, oriWS) Then
ws.columns(cRange).Copy
End If
For Each ws In newWB.Sheets
If InStr(1, ws.Name, newWS) Then
ws.columns(cRange).Paste
End If
next


next


next i


With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub



 

Some videos you may like

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
Hi hwexcel, Welcome to MrExcel Forum and Message Board.
You did not specify what error you are getting nor what line it occurred on, but I tried to clean the code up a little anyhow. See if it will work now. If you get an error message, note what the message says, click debug, then note the line of code highlighted in yellow. Those two pieces of information are usually needed to analyze what needs to be fixed. Give this modified version a try and post back if there is a problem.
Code:
Sub copypaste2() 'This macro will copy data from worksheets and past to "Target" sheet
Dim nLastCol As Long, nLastRow As Long, i As Long, nTargetLastRow As Long
Dim ws As Worksheet, wsTarget As Worksheet, sh As Worksheet
Dim oriPath As String, newPath As String, cRange As String, sFil As String, oriWS As String, newWS As String
Dim thisWB As Workbook, oriWB As Workbook, newWB As Workbook
    With Application
        .DisplayAlerts = False
        .EnableEvents = False
        .ScreenUpdating = False
    End With
Set thisWB = ThisWorkbook
oriPath = thisWB.Sheets("CopySheetCover").Range("A2").Value 'Change to suit
newPath = thisWB.Sheets("CopySheetCover").Range("A5").Value
cRange = thisWB.Sheets("CopySheetCover").Range("A8").Value 'e.g.A:E
Set oriWB = Workbooks.Open(oriPath)
Set newWB = Workbooks.Open(newPath)
nLastRow = thisWB.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1
    For i = 11 To nLastRow
    'Define the range and copy
        oriWS = thisWB.Sheets("CopySheetCover").Cells(i, "A").Value
        newWS = thisWB.Sheets("CopySheetCover").Cells(i, "B").Value
            For Each ws In oriWB.Sheets
                If InStr(1, ws.Name, oriWS) Then
                    ws.Columns(cRange).Copy
                End If
                For Each sh In newWB.Sheets
                    If InStr(1, sh.Name, newWS) Then
                        sh.Columns(cRange).PasteSpecial xlPasteAll
                    End If
                Next
            Next
    Next i
    With Application
        .DisplayAlerts = True
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub
 

hwexcel

New Member
Joined
Apr 18, 2013
Messages
4
Thank you JLGWhiz, I have tried the code and the error message as "Run-time error 91; Object variable or with block variable not set"
And when click debug, the yellow highlight just stop at first line.....so I really don't know what the problem is.....:(
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
Thank you JLGWhiz, I have tried the code and the error message as "Run-time error 91; Object variable or with block variable not set"
And when click debug, the yellow highlight just stop at first line.....so I really don't know what the problem is.....:(
Looks like I missed one. I believe this was the problem:
Code:
nLastRow = thisWB.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1
The variable ws has not been defined at that point in the code. I removed it, so if it still errors then check these possible causes.
1. sheets("CopySheetCover").Range("A2") does not contain a valid path and file name
2. sheets("CopySheetCover").Range("A5") does not contain a valid path and file name
Here is the corrected code:
Code:
Sub copypaste3() 'This macro will copy data from worksheets and past to "Target" sheet
Dim nLastCol As Long, nLastRow As Long, i As Long, nTargetLastRow As Long
Dim ws As Worksheet, wsTarget As Worksheet, sh As Worksheet
Dim oriPath As String, newPath As String, cRange As String, sFil As String, oriWS As String, newWS As String
Dim thisWB As Workbook, oriWB As Workbook, newWB As Workbook
    With Application
        .DisplayAlerts = False
        .EnableEvents = False
        .ScreenUpdating = False
    End With
Set thisWB = ThisWorkbook
oriPath = thisWB.Sheets("CopySheetCover").Range("A2").Value 'Change to suit
newPath = thisWB.Sheets("CopySheetCover").Range("A5").Value
cRange = thisWB.Sheets("CopySheetCover").Range("A8").Value 'e.g.A:E
Set oriWB = Workbooks.Open(oriPath)
Set newWB = Workbooks.Open(newPath)
nLastRow = thisWB.Cells(Rows.Count, "A").End(xlUp).Row + 1
    For i = 11 To nLastRow
    'Define the range and copy
        oriWS = thisWB.Sheets("CopySheetCover").Cells(i, "A").Value
        newWS = thisWB.Sheets("CopySheetCover").Cells(i, "B").Value
            For Each ws In oriWB.Sheets
                If InStr(1, ws.Name, oriWS) Then
                    ws.Columns(cRange).Copy
                End If
                For Each sh In newWB.Sheets
                    If InStr(1, sh.Name, newWS) Then
                        sh.Columns(cRange).PasteSpecial xlPasteAll
                    End If
                Next
            Next
    Next i
    With Application
        .DisplayAlerts = True
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub
Some explanation for changing the variable name in the second For Next loop: Since your second loop is embedded in the first loop, it cannot use the ws variable for the worksheets or it will produce an error because that variable is still being used by the first loop. If you had run the loops independently instead of embedded it would have worked OK. But since the second loop is embedded into the first loop, it was necessary to use a different variable.
 

hwexcel

New Member
Joined
Apr 18, 2013
Messages
4

ADVERTISEMENT

Looks like I missed one. I believe this was the problem:....

Thank you very much for your quick reply. ;)

Unfortunately, there is still an error message popup as "Object doesn't support this property or method (Error 438)".........And the yellow highlight still at first line......

But I checked that the path & file name are valid as I can get the value from other sub-code. So I am still confusing of the error.....:confused:
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
Thank you very much for your quick reply. ;)

Unfortunately, there is still an error message popup as "Object doesn't support this property or method (Error 438)".........And the yellow highlight still at first line......

But I checked that the path & file name are valid as I can get the value from other sub-code. So I am still confusing of the error.....:confused:

Well, let's give it another shot.
Code:
Sub copypaste4() 'This macro will copy data from worksheets and past to "Target" sheet
Dim nLastCol As Long, nLastRow As Long, i As Long, nTargetLastRow As Long
Dim ws As Worksheet, wsTarget As Worksheet, sh As Worksheet
Dim oriPath As String, newPath As String, cRange As String, sFil As String, oriWS As String, newWS As String
Dim thisWB As Workbook, oriWB As Workbook, newWB As Workbook
    With Application
        .DisplayAlerts = False
        .EnableEvents = False
        .ScreenUpdating = False
    End With
Set thisWB = ThisWorkbook
oriPath = thisWB.Sheets("CopySheetCover").Range("A2").Value 'Change to suit
newPath = thisWB.Sheets("CopySheetCover").Range("A5").Value
cRange = thisWB.Sheets("CopySheetCover").Range("A8").Value 'e.g.A:E
Set oriWB = Workbooks.Open(oriPath)
Set newWB = Workbooks.Open(newPath)
nLastRow = thisWB.Sheets("CopySheetCover").Cells(Rows.Count, "A").End(xlUp).Row + 1
    For i = 11 To nLastRow
    'Define the range and copy
        oriWS = thisWB.Sheets("CopySheetCover").Cells(i, "A").Value
        newWS = thisWB.Sheets("CopySheetCover").Cells(i, "B").Value
            For Each ws In oriWB.Sheets
                If InStr(1, ws.Name, oriWS) Then
                    ws.Columns(cRange).Copy
                End If
                For Each sh In newWB.Sheets
                    If InStr(1, sh.Name, newWS) Then
                        sh.Columns(cRange).PasteSpecial xlPasteAll
                    End If
                Next
            Next
    Next i
    With Application
        .DisplayAlerts = True
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,123,259
Messages
5,600,573
Members
414,389
Latest member
MarkElla

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top