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

[hwexcel]

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

 

[JLGWhiz]

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.

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]

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]

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:

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:

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]

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.....

 

[JLGWhiz]

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.....

Well, let's give it another shot.

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

 

[hwexcel]

Well, let's give it another shot.

It Work ! Thank you so much !! Now I learn the procedure to debug and understand the logic behind

 

[JLGWhiz]

It Work ! Thank you so much !! Now I learn the procedure to debug and understand the logic behind

We never stop learning.
Regards, JLG