VBA Makeshift Вопрос извлечения формы

Question

Цель моего кода - скопировать 1 oop из 1 папки из 40 плюс формы Excel в основную таблицу данных. Извлечение из форм осуществляется по заданным c ячейкам. Возникла проблема, заключающаяся в том, что если в форме № 1 ячейка пуста, то при обработке данных из формы № 2 эти данные вставляются туда, где должны быть данные из формы № 1. Могу ли я получить помощь в решении этой проблемы?

Кроме того, код написан на базовом c как есть, потому что я получил указание сделать это, поскольку я единственный в моей команде, кто немного знает VBA и они хотят, чтобы его можно было быстро поднять / справочные части легко, если я не здесь, чтобы исправить это в будущем.

Код:

'PURPOSE: To loop through all Excel files in a user specified folder and copy data values from 269a FSR sheet to the respective sheet in the MasterData file
'changes need to be made below in the Move269a statements

Dim wb As Workbook
Dim C269a As Worksheet
Dim P269a As Worksheet
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog

'Optimize Macro Speed
  Application.ScreenUpdating = False
  Application.EnableEvents = False

' Notify user of progress...
  oldStatusBar = Application.DisplayStatusBar
  Application.DisplayStatusBar = True
  Application.StatusBar = "Searching for files; please wait..."


'Retrieve Target Folder Path From User
  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

    With FldrPicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With

'In Case of Cancel
NextCode:
  myPath = myPath
  If myPath = "" Then GoTo ResetSettings

'Target File Extension (must include wildcard "*")
  myExtension = "*.xls*"

'Target Path with Ending Extention
  myFile = Dir(myPath & myExtension)

'Loop through each Excel file in folder
  Do While myFile <> ""
    'Set variable equal to opened workbook
      Set wb = Workbooks.Open(FileName:=myPath & myFile)

    'Ensure Workbook has opened before moving on to next line of code
      DoEvents

'*********Begin fill in 269a tab***********************************************
    Set C269a = wb.Sheets("269a")
    Set P269a = Workbooks("FSR_MasterData.xlsm").Worksheets("269a")

        'Report Activity D7
        C269a.Range("D7").Copy
        With P269a.Range("A" & Rows.Count).End(xlUp).Offset(1)
        .PasteSpecial Paste:=xlPasteColumnWidths
        .PasteSpecial Paste:=xlPasteValues
   End With
'Final Report A10
        C269a.Range("A10").Copy
        With P269a.Range("B" & Rows.Count).End(xlUp).Offset(1)
    .PasteSpecial Paste:=xlPasteColumnWidths
    .PasteSpecial Paste:=xlPasteValues
   End With
'Payee Vendor ID No.  E10
        C269a.Range("E10").Copy
        With P269a.Range("C" & Rows.Count).End(xlUp).Offset(1)
    .PasteSpecial Paste:=xlPasteColumnWidths
    .PasteSpecial Paste:=xlPasteValues
   End With
'Payee Name D11
        C269a.Range("D11").Copy
        With P269a.Range("D" & Rows.Count).End(xlUp).Offset(1)
    .PasteSpecial Paste:=xlPasteColumnWidths
    .PasteSpecial Paste:=xlPasteValues
   End With
'Address D13
        C269a.Range("D13").Copy
        With P269a.Range("E" & Rows.Count).End(xlUp).Offset(1)
    .PasteSpecial Paste:=xlPasteColumnWidths
    .PasteSpecial Paste:=xlPasteValues
   End With
'City D15
        C269a.Range("D15").Copy
        With P269a.Range("F" & Rows.Count).End(xlUp).Offset(1)
    .PasteSpecial Paste:=xlPasteColumnWidths
    .PasteSpecial Paste:=xlPasteValues
   End With
'State D18
        C269a.Range("D18").Copy
        With P269a.Range("G" & Rows.Count).End(xlUp).Offset(1)
    .PasteSpecial Paste:=xlPasteColumnWidths
    .PasteSpecial Paste:=xlPasteValues

   End With
'Zip code D19
        C269a.Range("D19").Copy
        With P269a.Range("H" & Rows.Count).End(xlUp).Offset(1)
    .PasteSpecial Paste:=xlPasteColumnWidths
    .PasteSpecial Paste:=xlPasteValues

   End With
'Contractor Name   F8
        C269a.Range("F8").Copy
        With P269a.Range("I" & Rows.Count).End(xlUp).Offset(1)
    .PasteSpecial Paste:=xlPasteColumnWidths
    .PasteSpecial Paste:=xlPasteValues
   End With
'HHSC_Contract_Number J9
        C269a.Range("J9").Copy
        With P269a.Range("J" & Rows.Count).End(xlUp).Offset(1)
    .PasteSpecial Paste:=xlPasteColumnWidths
    .PasteSpecial Paste:=xlPasteValues
   End With
'Basis  H10
        C269a.Range("H10").Copy
        With P269a.Range("K" & Rows.Count).End(xlUp).Offset(1)
    .PasteSpecial Paste:=xlPasteColumnWidths
    .PasteSpecial Paste:=xlPasteValues
   End With
'Contract_From - BegDate H13
        C269a.Range("H13").Copy
        With P269a.Range("L" & Rows.Count).End(xlUp).Offset(1)
    .PasteSpecial Paste:=xlPasteColumnWidths
    .PasteSpecial Paste:=xlPasteValues
   End With
'Contract_To - EndDate  K13
        C269a.Range("K13").Copy
        With P269a.Range("M" & Rows.Count).End(xlUp).Offset(1)
    .PasteSpecial Paste:=xlPasteColumnWidths
    .PasteSpecial Paste:=xlPasteValues
   End With
'Period_From - BegDate H18
        C269a.Range("H18").Copy
        With P269a.Range("N" & Rows.Count).End(xlUp).Offset(1)
    .PasteSpecial Paste:=xlPasteColumnWidths
    .PasteSpecial Paste:=xlPasteValues
   End With
'Save and Close Workbook
      wb.Close SaveChanges:=False

    'Ensure Workbook has closed before moving on to next line of code
      DoEvents

    'Get next file name
      myFile = Dir
  Loop

'Message Box when tasks are completed
  MsgBox "All data extracted from 269a complete!"

ResetSettings:
  'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.ScreenUpdating = True
   Application.StatusBar = False
   Application.DisplayStatusBar = oldStatusBar

End Sub```

Answer 1

Похоже, как данные копировались и вставлялись, когда вы записывали макрос от физического выполнения действий. Иногда это работает, но для чего-то подобного я бы предложил использовать количество строк ++ и сохранить значения для каждой новой строки в качестве вариантов из таблицы данных в новом листе Excel. Таким образом, вы можете сделать строку = строка + 1, где новые данные будут вставлены в следующую строку, а не поверх ваших предыдущих данных. Это гарантирует, что данные вставляются и никакие данные не вставляются.

Если честно, вам может понадобиться, чтобы кто-то разработал это для вас. Множество людей в Upwork могут сделать это за пару часов.

1. Цикл по динамическим диапазонам c на другом листе для строк с заданным текстом c в VBA

2. Я хочу объединить несколько листов в один консолидированный лист

Эти другие ответы переполнения стека на другой вопрос переполнения стека может помочь вам тоже:)