Giúp tạo Macro coppy File (1 người xem)

[robinhsoon]

Chào cộng đồng giaiphapexcel!
mình có 3 File:
+ Data + File 1 + File 2 - (đính kèm bên dưới)
- mình muốn coppy Data ở "File 1" sang File "Data"
và "File 2" coppy tiếp đuôi "File 1" tại File "Data"
các bạn Code giùm mình nha.!
Cảm ơn các bạn..

 

[vanthinh3101]

Chào cộng đồng giaiphapexcel!
mình có 3 File:
+ Data + File 1 + File 2 - (đính kèm bên dưới)
- mình muốn coppy Data ở "File 1" sang File "Data"
và "File 2" coppy tiếp đuôi "File 1" tại File "Data"
các bạn Code giùm mình nha.!
Cảm ơn các bạn..

Bạn xem file đính kèm nhé!
Khi chọn file thì bạn dùng phím Ctrl để chọn nhiều file cùng 1 lúc, muốn copy dữ liệu file nào trước thì chọn trước.
code này là mình lấy của DT_Nguyen rồi sửa lại 1 chút

 

[robinhsoon]

cảm ơn anh VanThinh3101 đã giúp e! cho e hỏi thêm, nếu hàng A1 (Temlate) không cố định thì mình làm cách nào anh..
TKS! anh

 

[robinhsoon]

Khi coppy những phần Range e bôi màu Vàng sao nó lại mất a.. có khắc phục được cái này không a

 

[PacificPR]

Khi coppy những phần Range e bôi màu Vàng sao nó lại mất a.. có khắc phục được cái này không a

Nếu lấy cái ô vàng thì bạn thử file này xem sao

 

[robinhsoon]

Nếu lấy cái ô vàng thì bạn thử file này xem sao

Cảm ơn a nha!... cho e hỏi thêm, e muốn coppy các hàng không cố định thì mình code sao a (hàng A1) ak..
TKs a nhiều.!

 

[PacificPR]

Cảm ơn a nha!... cho e hỏi thêm, e muốn coppy các hàng không cố định thì mình code sao a (hàng A1) ak..
TKs a nhiều.!

Hàng không cố định là sao vậy bạn. Mình không hiểu. Bạn làm vào file mẫu rồi gửi lên mình xem thử sao

 

[robinhsoon]

Hàng không cố định là sao vậy bạn. Mình không hiểu. Bạn làm vào file mẫu rồi gửi lên mình xem thử sao

là như zậy nè anh:
em muốn coppy File "File 1" vào File "Data"
Theo code của anh gửi cho e là chỉ Coppy tới cột F thôi.. Nhưng "Cột" nó thây đổi có lúc thì 10 cột lúc thì nhiều hơn số cột đó.. nói chung là nó không cố định ak
anh giúp em phần này nha..
Tks a!

 

[PacificPR]

là như zậy nè anh:
em muốn coppy File "File 1" vào File "Data"
Theo code của anh gửi cho e là chỉ Coppy tới cột F thôi.. Nhưng "Cột" nó thây đổi có lúc thì 10 cột lúc thì nhiều hơn số cột đó.. nói chung là nó không cố định ak
anh giúp em phần này nha..
Tks a!

Có phải là file nguồn có bao nhiêu cột thì lấy sang bấy nhiêu không bạn ( Như FILE 1 CÓ 459 CỘT)

 

[robinhsoon]

Có phải là file nguồn có bao nhiêu cột thì lấy sang bấy nhiêu không bạn ( Như FILE 1 CÓ 459 CỘT)[/QU]
đúng rồi anh.. có bao nhiêu thì lấy hết

 

[robinhsoon]

Có phải là file nguồn có bao nhiêu cột thì lấy sang bấy nhiêu không bạn ( Như FILE 1 CÓ 459 CỘT)

đúng rồi anh có bao nhiêu cột thì lấy sang hết

 

[robinhsoon]

Option Explicit


Public Sub GPE()
Dim cn As Object, rs As Object, fOld As String, fNew As String, Item
Application.ScreenUpdating = False
Set cn = CreateObject("ADODB.Connection")
If Application.Version < 12 Then
    fOld = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
    fNew = ";Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";"
Else
    fOld = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source="
    fNew = ";Extended Properties=""Excel 12.0;HDR=No;IMEX=1"";"
End If
With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = True
    .Filters.Add "Microsoft Excel Files", "*.xls*", 1
    If Not .Show = -1 Then MsgBox "Ban chua chon File": Exit Sub
For Each Item In .SelectedItems
    cn.Open (fOld & Item & fNew)
        Set rs = cn.Execute("select * from [LogicCheck$A2:QQ] where f1 is not null")
        If Not rs.EOF Then Range("A65000").End(3)(2).CopyFromRecordset rs
        rs.Close
        cn.Close
Next Item
End With
Set cn = Nothing
MsgBox "Da Tong Hop Xong!"
Application.ScreenUpdating = True
End Sub

code này không lấy được mấy ô tô vàng hả anh... e muốn coppy luôn nhưng ô có bôi vàng ak

 

[babe_nice]

Option Explicit


Public Sub GPE()
Dim cn As Object, rs As Object, fOld As String, fNew As String, Item
Application.ScreenUpdating = False
Set cn = CreateObject("ADODB.Connection")
If Application.Version < 12 Then
    fOld = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
    fNew = ";Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";"
Else
    fOld = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source="
    fNew = ";Extended Properties=""Excel 12.0;HDR=No;IMEX=1"";"
End If
With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = True
    .Filters.Add "Microsoft Excel Files", "*.xls*", 1
    If Not .Show = -1 Then MsgBox "Ban chua chon File": Exit Sub
For Each Item In .SelectedItems
    cn.Open (fOld & Item & fNew)
        Set rs = cn.Execute("select * from [LogicCheck$A2:QQ] where f1 is not null")
        If Not rs.EOF Then Range("A65000").End(3)(2).CopyFromRecordset rs
        rs.Close
        cn.Close
Next Item
End With
Set cn = Nothing
MsgBox "Da Tong Hop Xong!"
Application.ScreenUpdating = True
End Sub

chủ thớt kiểm tra dữ liệu từ code của anh
còn em thì em cám ơn anh, và phát hiện thấy anh hpkhuong đã lên đời ADO, ngày xưa thấy anh hay làm cách "truyền thống" hơn, hay tại anh biết " món " này rồi nhưng ít sử dụng.

 

[PacificPR]

đúng rồi anh có bao nhiêu cột thì lấy sang hết

Bạn kiểm tra thử xem nha

 

[robinhsoon]

Bạn kiểm tra thử xem nha

Cảm ơn anh vì đoạn code..! Em đã code được rồi ạ.. Nhưng.. e gặp một rắc rối nữa anh giúp em nhé!
khi Copy từ file Data sang macro "Gom Sheet" thì có những sheets nó có filter thì nó sẽ không coppy được những dữ liệu ở đó... em bỏ được filter ở sheet logic đầu nhưng những sheet còn lại e không bỏ được.. a giúp e nhé.. e đính kèm file bên dưới

 

[PacificPR]

Bạn thử thay dòng If ActiveSheet.AutoFilterMode = True Then ActiveSheet.AutoFilterMode = False thành Sh.AutoFilterMode = False sem sao

 

[vanthinh3101]

cảm ơn anh VanThinh3101 đã giúp e! cho e hỏi thêm, nếu hàng A1 (Temlate) không cố định thì mình làm cách nào anh..
TKS! anh

Mình đã sửa lại 1 chút rồi bạn nhé! Bạn kiểm tra xem được chưa?

 

[robinhsoon]

Mình đã sửa lại 1 chút rồi bạn nhé! Bạn kiểm tra xem được chưa?

Em làm được rồi ạ.. Em cảm ơn mọi người giúp em hoàn thành dự án này ạ..
sẵn đây cho e hỏi, đoạn code dưới nó bị sai gì ạ.. em muốn kiểm tra trong Workbook nếu đã tồn tại 1 sheet có tên "alogic" rồi thì nó sẽ kết thúc câu lệnh, nhưng em làm hoài mà báo lỗi hoài luôn..
Tks anh ạ..!

Sub coppySheet()
Dim mt As Worksheet
If mt.Name = "alogic" Then
MsgBox "Sheet da ton tai"
NoFile: Exit Sub
Else
For i = 1 To 11
Sheets.Add After:=Sheets(Sheets.Count)
Next i
Sheets("Sheet1").Name = "alogic"
Sheets("Sheet2").Name = "acomfirm"
With ActiveWorkbook.Sheets("alogic").Tab
.Color = 65535
.TintAndShade = 0
End With
With ActiveWorkbook.Sheets("acomfirm").Tab
.Color = 65535
.TintAndShade = 0
End With

End If
End Sub

 

[befaint]

@robinhsoon:

Dim mt As Worksheet
For Each mt In ThisWorkbook.Worksheets
    If mt.Name = "alogic" Then
        MsgBox "Sheet da ton tai": Exit Sub
    End If
Next mt