Excel Forum

Code: Select all

Private Sub CommandButton2_Click()
Dim fileToOpen
Dim rs As Range
Dim ri As Range
Dim ro As Range
Dim rx As Range
Dim r As Long
Dim Mydata As Range
Dim MyFile As String
Dim sFile As String
Dim xFile As String
Dim FileSaveName As String
'On Error Resume Next
Application.ScreenUpdating = False

With Workbooks("FBI.xlsm").Worksheets("Rest")
Set rs = Workbooks("FBI.xlsm").Worksheets("Rest").Range("A1")
End With

With Workbooks("FBI.xlsm").Worksheets("FBI")
Set ri = Workbooks("FBI.xlsm").Worksheets("FBI").Range("A1")
End With
fileToOpen = Application.GetOpenFilename '( _
      FileFilter:="WorkbookMacro (*.xls),*.xls")
      MyFile = fileToOpen

 If fileToOpen = False Then
  MsgBox "โปรดเลือกไฟล์ครับ"CIM 360"
 Exit Sub
 End If
 
 
  If fileToOpen <> False Then
Workbooks.OpenText Filename:=MyFile
  Application.DisplayAlerts = False
   rs.Value = ActiveWorkbook.Worksheets.Count 'ส่งจำนวนชีทไฟล์ที่เลือกไปเก็บไว้
   
   r = 1
   Do Until r = rs.Value
   If r = 1 Then
   ActiveWorkbook.Worksheets(r).Columns("A11:S30").Select ' ตำแหน่งที่เกิดปัญหา
 Selection.Copy: ri.PasteSpecial xlPasteValues
   Application.CutCopyMode = False
    Else
  ActiveWorkbook.Worksheets(r).Columns("A3:Q23").Select
 Selection.Copy: ri.PasteSpecial xlPasteValues
   Application.CutCopyMode = False
   End If
   With Workbooks("FBI.xlsm").Worksheets("FBI")
Set ro = .Range(.Range("A1"), .Range("S40") _
    .End(xlUp)).SpecialCells(xlCellTypeVisible)
  End With
  With Workbooks("FBI.xlsm").Worksheets("FBIX")
Set rx = Workbooks("FBI.xlsm").Worksheets("FBIX").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
End With
 ro.Select
 ro.Copy: rx.PasteSpecial xlPasteValues
  Application.CutCopyMode = False
  
   r = r + 1
     DoEvents
Loop
   
 ActiveWorkbook.Close True

 End If
 
End Sub

Code: Select all

'Other code
If r = 1 Then
    ActiveWorkbook.Worksheets(r).Select
    Range("A11:S30").Copy
    ri.PasteSpecial xlPasteValues
    Application.CutCopyMode = False
Else
    ActiveWorkbook.Worksheets(r).Select
    Range("A3:Q23").Copy
    ri.PasteSpecial xlPasteValues
   Application.CutCopyMode = False
End If
'Other code

Code: Select all

Private Sub CommandButton2_Click()
Dim fileToOpen
Dim rs As Range
Dim ri As Range
Dim ro As Range
Dim rx As Range
Dim r As Long
Dim x As String
Dim Mydata As Range
Dim MyFile As String
Dim sFile As String
Dim xFile As String
Dim FileSaveName As String
'On Error Resume Next
Application.ScreenUpdating = False
With Workbooks("FBI.xlsm").Worksheets("Rest")
Set rs = Workbooks("FBI.xlsm").Worksheets("Rest").Range("A1")
End With
With Workbooks("FBI.xlsm").Worksheets("FBI")
Set ri = Workbooks("FBI.xlsm").Worksheets("FBI").Range("A1")
End With

fileToOpen = Application.GetOpenFilename '( _
      FileFilter:="WorkbookMacro (*.xls),*.xls")
      MyFile = fileToOpen
 If fileToOpen = False Then
  MsgBox "โปรดเลือกไฟล์", vbOKOnly, "CIM 360"
 Exit Sub
 End If
 
 
  If fileToOpen <> False Then
Workbooks.OpenText Filename:=MyFile
  Application.DisplayAlerts = False
   rs.Value = ActiveWorkbook.Worksheets.Count
      r = 1
      Do Until r = rs.Value
 If r = 1 Then
    ActiveWorkbook.Worksheets(r).Select
    Range("E11:S30").Copy
    ri.PasteSpecial xlPasteValues
    'Application.CutCopyMode = False
Else
    ActiveWorkbook.Worksheets(r).Select
    Range("A3:Q23").Copy
    ri.PasteSpecial xlPasteValues
   'Application.CutCopyMode = False
End If
   With Workbooks("FBI.xlsm").Worksheets("FBI")
Set ro = .Range(.Range("A1"), .Range("S20") _
    .End(xlUp)).SpecialCells(xlCellTypeVisible)
  End With
  With Workbooks("FBI.xlsm").Worksheets("FBIX")
Set rx = Workbooks("FBI.xlsm").Worksheets("FBIX").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
End With
' ro.Select
 'ro.Copy: rx.PasteSpecial xlPasteValues
  'Application.CutCopyMode = False
    r = r + 1
    DoEvents
Loop
   
 ActiveWorkbook.Close True
 
 End If
 
End Sub