vba based on cell value to open another workbook and paste data

[LAMB_LAMB]

I am beginner. I want to write VBA to base on the column "A" value to open the workbooks is same name. and copy column B to E value to this workbook.

Such as Open workbook "PRO" (A2) and paste Column "B2:E2"value to workbook"PRO".sheet"BB" column (A: D)

File name	Date	invoice no	Model no	qty
PRO	2024/4/3	AA1234	CHKEEU	1
NEW	2024/4/4	AA1235	NOVEM	2
OLD	2024/4/6	AA1236	KKBOX	3

Sub statem()


Dim i As Integer
Dim wbm As Workbook
Dim wbL As Workbook
Dim masterNextRow As Long

For i = 2 To 40

Set wbL = ThisWorkbook
Set wbm = Workbooks.Open(ThisWorkbook.Path & "\" & Worksheets("LIST").Cells(i, 1) & ".xlsm")
masterNextRow = wbm.Worksheets("BB").Range("A" & wbm.Worksheets("BB").Rows.Count).End(xlUp).Offset(1)

wbL.Worksheets("LIST").Range(i, 2).Copy
wbm.Worksheets("BB").Cells(masterNextRow, 1).PasteSpecial Paste:=xlPaasteValues
wbL.Worksheets("LIST").Range(i, 3).Copy
wbm.Worksheets("BB").Cells(masterNextRow, 2).PasteSpecial Paste:=xlPaasteValues
wbL.Worksheets("LIST").Range(i, 4).Copy
wbm.Worksheets("BB").Cells(masterNextRow, 3).PasteSpecial Paste:=xlPaasteValues

Next i
wbm.Close True


End Sub

 

[kevin9999]

Please try the following on a copy of your workbook. Assumes all your destination files are type macro-enabled.

Option Explicit
Sub statem()
    Dim wbm As Workbook, wsSrc As Worksheet
    Set wsSrc = Worksheets("LIST")
    Dim i As Long
    For i = 2 To 40
        If wsSrc.Cells(i, 1) <> "" Then
            On Error Resume Next
            Set wbm = Workbooks.Open(ThisWorkbook.Path & "\" & wsSrc.Cells(i, 1) & ".xlsm")
            On Error GoTo 0
            wsSrc.Range(wsSrc.Cells(i, 2), wsSrc.Cells(i, 4)).Copy
            wbm.Worksheets("BB").Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial xlPasteValues
            Application.CutCopyMode = False
            wbm.Close True
        End If
    Next i
End Sub

 

[LAMB_LAMB]

Please try the following on a copy of your workbook. Assumes all your destination files are type macro-enabled.

Option Explicit
Sub statem()
    Dim wbm As Workbook, wsSrc As Worksheet
    Set wsSrc = Worksheets("LIST")
    Dim i As Long
    For i = 2 To 40
        If wsSrc.Cells(i, 1) <> "" Then
            On Error Resume Next
            Set wbm = Workbooks.Open(ThisWorkbook.Path & "\" & wsSrc.Cells(i, 1) & ".xlsm")
            On Error GoTo 0
            wsSrc.Range(wsSrc.Cells(i, 2), wsSrc.Cells(i, 4)).Copy
            wbm.Worksheets("BB").Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial xlPasteValues
            Application.CutCopyMode = False
            wbm.Close True
        End If
    Next i
End Sub

Thank you for your help. Success.

 

[kevin9999]

Happy to help, and welcome to the forum!